(*$R-*) (* turn range checking off *)
(*$S+*) (* turn swapping on *)
(* $L+*) (* no listing *)

Unit ParseUnit;

{ This is a unit because the magiscan does have enough memory
  to hold it without swapping }

Interface
 
Uses
  M2Types,M2IpRoot,M2Sys;

 
  (* Parser Types *)
 
  type
    statustype = (null, at_eol, unconfirmed, parm_expected, ambiguous,
                  unrec, fn_expected, ch_expected);
 
    vocab = (nullsym, zerosym, onesym, twosym, threesym, foursym,
             fivesym, sixsym, sevensym, eightsym, ninesym,
             allsym, baudsym, binsym, consym, datasym,
             debugsym, delsym, dirsym, disksym, escsym, evensym,
             exitsym, filewarnsym, helpsym, ibmsym, imagesym, loadsym, localsym,
             marksym, muxsym, nonesym, oddsym, offsym, onsym, paritysym,
             quitsym, recsym, sendsym, setsym, showsym,
             spacesym, textsym, transym, typesym );
 
  (* Parser vars *)
  var
    noun, verb, adj     : vocab;
    status              : statustype;
    vocablist           : array[vocab] of string[13];
    value               : integer;
    filename, line      : string;
    newescchar          : char;
    expected            : set of vocab;

  procedure uppercase(var s: string);
 
  procedure initvocab;
 
  function parse: statustype;


Implementation


(* ---------------------------------------------------- *)

procedure uppercase;

var
  i: integer;

begin
for i := 1 to length(s) do
  if s[i] in ['a'..'z'] then
    s[i] := chr(ord(s[i]) - ord('a') + ord('A'))
end; (* uppercase *)

(* ---------------------------------------------------- *)

function parse;

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,
            get_value, exitstate, get_trans, get_type);

var
  status: statustype;
  word: vocab;
  state: states;

  procedure eatspaces(var s: string);
 
  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: string);
 
  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: string): 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 getch(var ch: char): boolean;
 
  var s: string;
 
    begin
      isolate_word(line,s);
      if length(s) <> 1 then
          getch := false
      else
        begin
          ch := s[1];
          get_ch := true
        end (* else *)
    end; (* getch *)
 
 
  function get_sym(var word: vocab): statustype;
 
  var i: vocab;
      s: string;
      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 = typesym) 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 get_val(var value : integer): statustype;
 
  var i: vocab;
      s: string;
      stat: statustype;
      gotval,done: boolean;
 
      function NewVal(Value  : integer;
                      S      : vocab  ) : integer;
 
      begin
      case S of
        zerosym  : NewVal := Value * 10 + 0;
        onesym   : NewVal := Value * 10 + 1;
        twosym   : NewVal := Value * 10 + 2;
        threesym : NewVal := Value * 10 + 3;
        foursym  : NewVal := Value * 10 + 4;
        fivesym  : NewVal := Value * 10 + 5;
        sixsym   : NewVal := Value * 10 + 6;
        sevensym : NewVal := Value * 10 + 7;
        eightsym : NewVal := Value * 10 + 8;
        ninesym  : NewVal := Value * 10 + 9
        end{case}
      end{NewVal};
 
      function NextDigit : boolean;
 
      var
        i   : integer;
 
      begin
      if length(s) <= 1 then
        NextDigit := False
       else
         begin
         i := length(s) - 1;
         s := copy(s,2,i);
         NextDigit := True
         end
      end{NextDigit};
 
 
    begin
      eat_spaces(line);
      if length(line) = 0 then
        getval := ateol
      else
        begin
          stat := null;
          done := false;
          isolate_word(line,s);
          value := 0;
          repeat
 
            GotVal := False;
            for i := zerosym to ninesym do
              if (s[1] = vocablist[i][1]) then
                begin
                Value := NewVal(value,i);
                GotVal := True
                end;
            if not GotVal then
              begin
              stat := unrec;
              done := True
              end
             else
               done := not NextDigit
 
          until done;
          getval := stat
        end (* else *)
    end; (* getval *)
 
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, delsym, dirsym, sendsym,
                        setsym, showsym, transym, loadsym];
         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
                  dirsym, consym: state := fin;
                  exitsym, quitsym: state := fin;
                  helpsym: state := get_help_parm;
                  recsym: state := fin;
                  loadsym, delsym, sendsym: state := getfilename;
                  setsym: state := get_set_parm;
                  showsym: state := get_show_parm;
                  transym: state := get_trans;
                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,filename) then
            begin
              status := null;
              state := fin
            end (* if *)
          else
              status := fnexpected
        end; (* case get file name *)
      get_trans:
          begin
          expected := [typesym];
            status := getsym(noun);
            if status = ateol then
                status := parm_expected
            else if (status <> unrec) and (status <>  ambiguous) then
                case noun of
                  typesym: state := get_type;
                end (* case *)
        end; (* case get_set_parm *)
      get_set_parm:
          begin
          expected := [paritysym, localsym, ibmsym, escsym, muxsym,
                      disksym, 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;
                  escsym: state := getchar;
                  debugsym: state := getonoff;
                  filewarnsym: state := getonoff;
                  muxsym, baudsym : state := getvalue;
                  disksym : state := getvalue;
                  transym : state := get_on_off;
                end (* case *)
        end; (* case get_set_parm *)
      get_type:
          begin
            expected := [binsym, datasym, imagesym, textsym];
            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_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_value:
             begin
               expected := [zerosym, onesym, twosym,
                            threesym, foursym, fivesym,
                            sixsym, sevensym, eightsym,
                            ninesym];
               status := getval(value);
               if status = ateol then
                   status := parm_expected
                else
                 if (status <> unrec) and (status <> ambiguous) then
                   state := fin
             end; (* get_speed *)
      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 getch(newescchar) then
             state := fin
          else
             status := ch_expected;
      get_show_parm:
          begin
          expected := [allsym, paritysym, localsym, ibmsym, escsym,
                       muxsym, transym, disksym, baudsym, debugsym, filewarnsym];
            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];
            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, delsym, exitsym, helpsym,
                        quitsym, recsym, dirsym, transym, 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[zerosym] :=     '0';
    vocablist[onesym] :=      '1';
    vocablist[twosym] :=      '2';
    vocablist[threesym] :=    '3';
    vocablist[foursym] :=     '4';
    vocablist[fivesym] :=     '5';
    vocablist[sixsym] :=      '6';
    vocablist[sevensym] :=    '7';
    vocablist[eightsym] :=    '8';
    vocablist[ninesym] :=     '9';
    vocablist[allsym] :=      'ALL';
    vocablist[baudsym] :=     'BAUDRATE';
    vocablist[binsym] :=      'BINARY';
    vocablist[consym] :=      'CONNECT';
    vocablist[datasym] :=     'DATA';
    vocablist[debugsym] :=    'DEBUG';
    vocablist[delsym] :=      'DELETE';
    vocablist[dirsym] :=      'DIRECTORY';
    vocablist[disksym] :=     'DISK';
    vocablist[escsym] :=      'ESCAPE';
    vocablist[evensym] :=     'EVEN';
    vocablist[exitsym] :=     'EXIT';
    vocablist[filewarnsym] := 'FILE-WARNING';
    vocablist[helpsym] :=     'HELP';
    vocablist[ibmsym] :=      'IBM';
    vocablist[imagesym] :=    'IMAGE';
    vocablist[loadsym] :=     'LOAD';
    vocablist[localsym] :=    'LOCAL-ECHO';
    vocablist[marksym] :=     'MARK';
    vocablist[muxsym] :=      'MUX';
    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';
    vocablist[transym] :=     'TRANSFER';
    vocablist[textsym] :=     'TEXT';
    vocablist[typesym] :=     'TYPE';
  end; (* initvocab *)



(* ---------------------------------------------------- *)



end{Parse}.