home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / pub / ucsdmagiscan2 / parunit.text < prev    next >
Text File  |  2020-01-01  |  14KB  |  504 lines

  1.  
  2. (*$R-*) (* turn range checking off *)
  3. (*$S+*) (* turn swapping on *)
  4. (* $L+*) (* no listing *)
  5.  
  6. Unit ParseUnit;
  7.  
  8. { This is a unit because the magiscan does have enough memory
  9.   to hold it without swapping }
  10.  
  11. Interface
  12.  
  13. Uses
  14.   M2Types,M2IpRoot,M2Sys;
  15.  
  16.  
  17.   (* Parser Types *)
  18.  
  19.   type
  20.     statustype = (null, at_eol, unconfirmed, parm_expected, ambiguous,
  21.                   unrec, fn_expected, ch_expected);
  22.  
  23.     vocab = (nullsym, zerosym, onesym, twosym, threesym, foursym,
  24.              fivesym, sixsym, sevensym, eightsym, ninesym,
  25.              allsym, baudsym, binsym, consym, datasym,
  26.              debugsym, delsym, dirsym, disksym, escsym, evensym,
  27.              exitsym, filewarnsym, helpsym, ibmsym, imagesym, loadsym, localsym,
  28.              marksym, muxsym, nonesym, oddsym, offsym, onsym, paritysym,
  29.              quitsym, recsym, sendsym, setsym, showsym,
  30.              spacesym, textsym, transym, typesym );
  31.  
  32.   (* Parser vars *)
  33.   var
  34.     noun, verb, adj     : vocab;
  35.     status              : statustype;
  36.     vocablist           : array[vocab] of string[13];
  37.     value               : integer;
  38.     filename, line      : string;
  39.     newescchar          : char;
  40.     expected            : set of vocab;
  41.  
  42.   procedure uppercase(var s: string);
  43.  
  44.   procedure initvocab;
  45.  
  46.   function parse: statustype;
  47.  
  48.  
  49. Implementation
  50.  
  51.  
  52. (* ---------------------------------------------------- *)
  53.  
  54. procedure uppercase;
  55.  
  56. var
  57.   i: integer;
  58.  
  59. begin
  60. for i := 1 to length(s) do
  61.   if s[i] in ['a'..'z'] then
  62.     s[i] := chr(ord(s[i]) - ord('a') + ord('A'))
  63. end; (* uppercase *)
  64.  
  65. (* ---------------------------------------------------- *)
  66.  
  67. function parse;
  68.  
  69. type
  70.   states = (start, fin, get_filename, get_set_parm, get_parity, get_on_off,
  71.             get_char, get_show_parm, get_help_show, get_help_parm,
  72.             get_value, exitstate, get_trans, get_type);
  73.  
  74. var
  75.   status: statustype;
  76.   word: vocab;
  77.   state: states;
  78.  
  79.   procedure eatspaces(var s: string);
  80.  
  81.   var done: boolean;
  82.       i: integer;
  83.  
  84.     begin
  85.       done := (length(s) = 0);
  86.       while not done do
  87.         begin
  88.           if s[1] = ' ' then
  89.             begin
  90.               i := length(s) - 1;
  91.               s := copy(s,2,i);
  92.               done := length(s) = 0
  93.             end (* if *)
  94.           else
  95.               done := true
  96.         end (* while *)
  97.     end; (* eatspaces *)
  98.  
  99.   procedure isolate_word(var line, s: string);
  100.  
  101.   var i: integer;
  102.       done: boolean;
  103.  
  104.     begin
  105.       done := false;
  106.       i := 1;
  107.       s := copy(' ',0,0);
  108.       while (i <= length(line)) and not done do
  109.         begin
  110.           if line[i] = ' ' then
  111.               done := true
  112.           else
  113.               s := concat(s,copy(line,i,1));
  114.           i := i + 1;
  115.         end; (* while *)
  116.       line := copy(line,i,length(line)-i+1);
  117.     end; (* isolate_word *)
  118.  
  119.   function get_fn(var line, fn: string): boolean;
  120.  
  121.   var i, l: integer;
  122.  
  123.     begin
  124.       get_fn := true;
  125.       isolate_word(line, fn);
  126.       l := length(fn);
  127.       if (l < 1) then
  128.           get_fn := false
  129.     end; (* get_fn *)
  130.  
  131.   function getch(var ch: char): boolean;
  132.  
  133.   var s: string;
  134.  
  135.     begin
  136.       isolate_word(line,s);
  137.       if length(s) <> 1 then
  138.           getch := false
  139.       else
  140.         begin
  141.           ch := s[1];
  142.           get_ch := true
  143.         end (* else *)
  144.     end; (* getch *)
  145.  
  146.  
  147.   function get_sym(var word: vocab): statustype;
  148.  
  149.   var i: vocab;
  150.       s: string;
  151.       stat: statustype;
  152.       done: boolean;
  153.       matches: integer;
  154.  
  155.     begin
  156.       eat_spaces(line);
  157.       if length(line) = 0 then
  158.           getsym := ateol
  159.       else
  160.         begin
  161.           stat := null;
  162.           done := false;
  163.           isolate_word(line,s);
  164.           i := allsym;
  165.           matches := 0;
  166.           repeat
  167.              if (pos(s,vocablist[i]) = 1) and (i in expected) then
  168.                 begin
  169.                   matches := matches + 1;
  170.                   word := i
  171.                 end
  172.               else if (s[1] < vocablist[i,1]) then
  173.                   done := true;
  174.               if (i = typesym) then
  175.                   done := true
  176.               else
  177.                   i := succ(i)
  178.           until (matches > 1) or done;
  179.           if matches > 1 then
  180.               stat := ambiguous
  181.           else if (matches = 0) then
  182.               stat := unrec;
  183.           getsym := stat
  184.         end (* else *)
  185.     end; (* getsym *)
  186.  
  187.   function get_val(var value : integer): statustype;
  188.  
  189.   var i: vocab;
  190.       s: string;
  191.       stat: statustype;
  192.       gotval,done: boolean;
  193.  
  194.       function NewVal(Value  : integer;
  195.                       S      : vocab  ) : integer;
  196.  
  197.       begin
  198.       case S of
  199.         zerosym  : NewVal := Value * 10 + 0;
  200.         onesym   : NewVal := Value * 10 + 1;
  201.         twosym   : NewVal := Value * 10 + 2;
  202.         threesym : NewVal := Value * 10 + 3;
  203.         foursym  : NewVal := Value * 10 + 4;
  204.         fivesym  : NewVal := Value * 10 + 5;
  205.         sixsym   : NewVal := Value * 10 + 6;
  206.         sevensym : NewVal := Value * 10 + 7;
  207.         eightsym : NewVal := Value * 10 + 8;
  208.         ninesym  : NewVal := Value * 10 + 9
  209.         end{case}
  210.       end{NewVal};
  211.  
  212.       function NextDigit : boolean;
  213.  
  214.       var
  215.         i   : integer;
  216.  
  217.       begin
  218.       if length(s) <= 1 then
  219.         NextDigit := False
  220.        else
  221.          begin
  222.          i := length(s) - 1;
  223.          s := copy(s,2,i);
  224.          NextDigit := True
  225.          end
  226.       end{NextDigit};
  227.  
  228.  
  229.     begin
  230.       eat_spaces(line);
  231.       if length(line) = 0 then
  232.         getval := ateol
  233.       else
  234.         begin
  235.           stat := null;
  236.           done := false;
  237.           isolate_word(line,s);
  238.           value := 0;
  239.           repeat
  240.  
  241.             GotVal := False;
  242.             for i := zerosym to ninesym do
  243.               if (s[1] = vocablist[i][1]) then
  244.                 begin
  245.                 Value := NewVal(value,i);
  246.                 GotVal := True
  247.                 end;
  248.             if not GotVal then
  249.               begin
  250.               stat := unrec;
  251.               done := True
  252.               end
  253.              else
  254.                done := not NextDigit
  255.  
  256.           until done;
  257.           getval := stat
  258.         end (* else *)
  259.     end; (* getval *)
  260.  
  261. begin
  262. state := start;
  263. parse := null;
  264. noun := nullsym;
  265. verb := nullsym;
  266. adj := nullsym;
  267. uppercase(line);
  268. repeat
  269.    case state of
  270.      start:
  271.          begin
  272.            expected := [consym, exitsym, helpsym, quitsym,
  273.                         recsym, delsym, dirsym, sendsym,
  274.                         setsym, showsym, transym, loadsym];
  275.          status := getsym(verb);
  276.          if status = ateol then
  277.            begin
  278.              parse := null;
  279.              exit(parse)
  280.            end (* if *)
  281.          else
  282.            if (status <> unrec) and (status <>  ambiguous) then
  283.              case verb of
  284.                   dirsym, consym: state := fin;
  285.                   exitsym, quitsym: state := fin;
  286.                   helpsym: state := get_help_parm;
  287.                   recsym: state := fin;
  288.                   loadsym, delsym, sendsym: state := getfilename;
  289.                   setsym: state := get_set_parm;
  290.                   showsym: state := get_show_parm;
  291.                   transym: state := get_trans;
  292.                 end (* case *);
  293.           end; (* case start *)
  294.       fin:
  295.           begin
  296.             expected := [];
  297.             status := getsym(verb);
  298.             if status = ateol then
  299.               begin
  300.                 parse := null;
  301.                 exit(parse)
  302.               end (* if status *)
  303.             else
  304.                 status := unconfirmed
  305.           end; (* case fin *)
  306.       getfilename:
  307.         begin
  308.           expected := [];
  309.           if getfn(line,filename) then
  310.             begin
  311.               status := null;
  312.               state := fin
  313.             end (* if *)
  314.           else
  315.               status := fnexpected
  316.         end; (* case get file name *)
  317.       get_trans:
  318.           begin
  319.           expected := [typesym];
  320.             status := getsym(noun);
  321.             if status = ateol then
  322.                 status := parm_expected
  323.             else if (status <> unrec) and (status <>  ambiguous) then
  324.                 case noun of
  325.                   typesym: state := get_type;
  326.                 end (* case *)
  327.         end; (* case get_set_parm *)
  328.       get_set_parm:
  329.           begin
  330.           expected := [paritysym, localsym, ibmsym, escsym, muxsym,
  331.                       disksym, debugsym, filewarnsym, baudsym];
  332.             status := getsym(noun);
  333.             if status = ateol then
  334.                 status := parm_expected
  335.             else if (status <> unrec) and (status <>  ambiguous) then
  336.                 case noun of
  337.                   paritysym: state := get_parity;
  338.                   localsym: state := get_on_off;
  339.                   ibmsym: state := get_on_off;
  340.                   escsym: state := getchar;
  341.                   debugsym: state := getonoff;
  342.                   filewarnsym: state := getonoff;
  343.                   muxsym, baudsym : state := getvalue;
  344.                   disksym : state := getvalue;
  345.                   transym : state := get_on_off;
  346.                 end (* case *)
  347.         end; (* case get_set_parm *)
  348.       get_type:
  349.           begin
  350.             expected := [binsym, datasym, imagesym, textsym];
  351.             status := getsym(adj);
  352.             if status = ateol then
  353.                 status := parm_expected
  354.             else if (status <> unrec) and (status <> ambiguous) then
  355.                 state := fin
  356.           end; (* case get_parity  *)
  357.       get_parity:
  358.           begin
  359.             expected := [marksym, spacesym, nonesym, evensym, oddsym];
  360.             status := getsym(adj);
  361.             if status = ateol then
  362.                 status := parm_expected
  363.             else if (status <> unrec) and (status <> ambiguous) then
  364.                 state := fin
  365.           end; (* case get_parity  *)
  366.       get_value:
  367.              begin
  368.                expected := [zerosym, onesym, twosym,
  369.                             threesym, foursym, fivesym,
  370.                             sixsym, sevensym, eightsym,
  371.                             ninesym];
  372.                status := getval(value);
  373.                if status = ateol then
  374.                    status := parm_expected
  375.                 else
  376.                  if (status <> unrec) and (status <> ambiguous) then
  377.                    state := fin
  378.              end; (* get_speed *)
  379.       get_on_off:
  380.           begin
  381.             expected := [onsym, offsym];
  382.             status := getsym(adj);
  383.             if status = ateol then
  384.                 status := parm_expected
  385.             else if (status <> unrec) and (status <> ambiguous) then
  386.                 state := fin
  387.           end; (* get_on_off *)
  388.       get_char:
  389.           if getch(newescchar) then
  390.              state := fin
  391.           else
  392.              status := ch_expected;
  393.       get_show_parm:
  394.           begin
  395.           expected := [allsym, paritysym, localsym, ibmsym, escsym,
  396.                        muxsym, transym, disksym, baudsym, debugsym, filewarnsym];
  397.             status := getsym(noun);
  398.             if status = ateol then
  399.                 status := parm_expected
  400.             else if (status <> unrec) and (status <>  ambiguous) then
  401.                 state := fin
  402.           end; (* case get_show_parm *)
  403.       get_help_show:
  404.           begin
  405.             expected := [paritysym, localsym, ibmsym, escsym,
  406.                         debugsym, filewarnsym];
  407.             status := getsym(adj);
  408.             if (status = at_eol) then
  409.               begin
  410.                 status := null;
  411.                 state := fin
  412.               end
  413.             else if (status <> unrec) and (status <>  ambiguous) then
  414.                 state := fin
  415.           end; (* case get_help_show *)
  416.       get_help_parm:
  417.           begin
  418.             expected := [consym, delsym, exitsym, helpsym,
  419.                         quitsym, recsym, dirsym, transym, sendsym,
  420.                         setsym, showsym];
  421.             status := getsym(noun);
  422.             if status = ateol then
  423.               begin
  424.                 parse := null;
  425.                 exit(parse)
  426.               end;
  427.             if (status <> unrec) and (status <>  ambiguous) then
  428.                 case noun of
  429.                   consym: state := fin;
  430.                   sendsym: state := fin;
  431.                   recsym: state := fin;
  432.                   setsym: state := get_help_show;
  433.                   showsym: state := fin;
  434.                   helpsym: state := fin;
  435.                   exitsym, quitsym: state := fin;
  436.                 end (* case *)
  437.           end; (* case get_help_show *)
  438.     end (* case *)
  439. until (status <> null);
  440. parse := status
  441. end; (* parse *)
  442.  
  443. (* ---------------------------------------------------- *)
  444.  
  445. procedure initvocab;
  446.  
  447. var i: integer;
  448.  
  449.   begin
  450.     vocablist[zerosym] :=     '0';
  451.     vocablist[onesym] :=      '1';
  452.     vocablist[twosym] :=      '2';
  453.     vocablist[threesym] :=    '3';
  454.     vocablist[foursym] :=     '4';
  455.     vocablist[fivesym] :=     '5';
  456.     vocablist[sixsym] :=      '6';
  457.     vocablist[sevensym] :=    '7';
  458.     vocablist[eightsym] :=    '8';
  459.     vocablist[ninesym] :=     '9';
  460.     vocablist[allsym] :=      'ALL';
  461.     vocablist[baudsym] :=     'BAUDRATE';
  462.     vocablist[binsym] :=      'BINARY';
  463.     vocablist[consym] :=      'CONNECT';
  464.     vocablist[datasym] :=     'DATA';
  465.     vocablist[debugsym] :=    'DEBUG';
  466.     vocablist[delsym] :=      'DELETE';
  467.     vocablist[dirsym] :=      'DIRECTORY';
  468.     vocablist[disksym] :=     'DISK';
  469.     vocablist[escsym] :=      'ESCAPE';
  470.     vocablist[evensym] :=     'EVEN';
  471.     vocablist[exitsym] :=     'EXIT';
  472.     vocablist[filewarnsym] := 'FILE-WARNING';
  473.     vocablist[helpsym] :=     'HELP';
  474.     vocablist[ibmsym] :=      'IBM';
  475.     vocablist[imagesym] :=    'IMAGE';
  476.     vocablist[loadsym] :=     'LOAD';
  477.     vocablist[localsym] :=    'LOCAL-ECHO';
  478.     vocablist[marksym] :=     'MARK';
  479.     vocablist[muxsym] :=      'MUX';
  480.     vocablist[nonesym] :=     'NONE';
  481.     vocablist[oddsym] :=      'ODD';
  482.     vocablist[offsym] :=      'OFF';
  483.     vocablist[onsym] :=       'ON';
  484.     vocablist[paritysym] :=   'PARITY';
  485.     vocablist[quitsym] :=     'QUIT';
  486.     vocablist[recsym] :=      'RECEIVE';
  487.     vocablist[sendsym] :=     'SEND';
  488.     vocablist[setsym] :=      'SET';
  489.     vocablist[showsym] :=     'SHOW';
  490.     vocablist[spacesym] :=    'SPACE';
  491.     vocablist[transym] :=     'TRANSFER';
  492.     vocablist[textsym] :=     'TEXT';
  493.     vocablist[typesym] :=     'TYPE';
  494.   end; (* initvocab *)
  495.  
  496.  
  497.  
  498. (* ---------------------------------------------------- *)
  499.  
  500.  
  501.  
  502. end{Parse}.
  503.  
  504.