home *** CD-ROM | disk | FTP | other *** search
/ kermit.columbia.edu / kermit.columbia.edu.tar / kermit.columbia.edu / ucsdappleii / parser.text < prev    next >
Text File  |  1986-04-07  |  15KB  |  472 lines

  1. (*>>>>>>>>>>>>PARSER>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>*)
  2.  
  3. (*$S+*)
  4. (*$I-*)
  5. (*$R-*)
  6. (*$V-*)
  7.  
  8. UNIT parser;   INTRINSIC CODE 23  DATA 24;
  9.  
  10.  
  11. INTERFACE
  12.  
  13. USES  kermglob,
  14.       kermutil;
  15.  
  16. FUNCTION parse: statustype;
  17.  
  18.  
  19. IMPLEMENTATION
  20.  
  21. VAR first_sym, last_sym : vocab;
  22.  
  23.  
  24.  
  25. PROCEDURE isolate_word ( var line, word : string; var wlen : integer );
  26.  
  27. var  line_len : integer;
  28.  
  29. begin
  30.   word := '';  wlen := 0;  linelen := length( line );
  31.   if linelen > 0
  32.     then begin
  33.            delete( line, 1, scan( linelen, <> ' ', line[1] ) );
  34.            linelen := length( line );
  35.            if linelen > 0
  36.              then begin
  37.                     wlen := scan( linelen, = ' ', line[1] );
  38.                     word := copy( line, 1, wlen );
  39.                     delete( line, 1, wlen );
  40.                   end;
  41.          end;
  42. end;  { isolate_word }
  43.  
  44.  
  45.  
  46. FUNCTION get_fn( var line, fn: string; namelen : integer ) : boolean;
  47.  
  48.  checks the length of the filename requested for 'send'.              
  49.  Or checks the prefix volume name for files to be received.           
  50.  
  51. var i, l: integer;
  52.  
  53. begin
  54.   get_fn := true;
  55.   isolate_word( line, fn, l );
  56.   if (l > namelen) or (l < 1) then get_fn := false
  57.    { max filename length, incl. volumename = 23 }
  58.    { max volumename length, incl. ':' = 8 }
  59.   else begin
  60.          if (fn[l] = ':') and (namelen=23)  then get_fn := false;
  61.          if (fn[l] <> ':') and (namelen=8)  then get_fn := false;
  62.          {  legality of volume and filename will be tested   }
  63.          {  when the file is actually opened. ( see unit "sender" )   }
  64.        end;
  65. end; (* get_fn *)
  66.  
  67.  
  68.  
  69.  
  70. FUNCTION get_num( var line: string; var n: integer ): boolean;
  71.  
  72. var
  73.    numstr: string;
  74.    i, numstr_len  : integer;
  75. begin
  76.    get_num := true; n := 0;
  77.    isolate_word( line, numstr, numstr_len );
  78.    if (numstr_len < 6) and (numstr_len > 0) then
  79.      begin
  80.        i := 1;
  81.        numstr := concat( numstr, ' ' );
  82.        while (numstr[i] in ['0'..'9']) do begin
  83.           if n<(maxint div 10) then
  84.              n := n*10 + ord( numstr[i] ) - ord( '0' );
  85.           i := i + 1
  86.        end { while }
  87.      end; { if }
  88.    if n = 0 then get_num := false;
  89. end; { get_num }
  90.  
  91.  
  92.  
  93.  
  94. FUNCTION nextch(var ch: char): boolean;
  95.  
  96. var s: string;
  97.     ch_len : integer;
  98.  
  99. begin
  100.  isolate_word( line, s, ch_len );
  101.  if ch_len <= 1 then begin
  102.                        if ch_len = 1 then ch := s[1]
  103.                                      else ch := cr;
  104.                        nextch := true;
  105.                      end
  106.                 else nextch := false;
  107. end; (* nextch *)
  108.  
  109.  
  110.  
  111. FUNCTION get_sym(var word: vocab): statustype;
  112.  
  113. var i: vocab;
  114.     s: string;
  115.     stat: statustype;
  116.     done: boolean;
  117.     matches, slen : integer;
  118.  
  119. begin
  120.   isolate_word( line, s, slen );
  121.   if slen = 0 then getsym := ateol
  122.    else
  123.      begin
  124.        stat := null;
  125.        done := false;
  126.        i := first_sym;
  127.        matches := 0;
  128.        repeat
  129.            if (pos(s,vocablist[i]) = 1) and (i in expected) then
  130.              begin
  131.                matches := matches + 1;
  132.                word := i
  133.              end
  134.            else if (s[1] < vocablist[i,1]) then
  135.                done := true;
  136.            if (i = last_sym ) then
  137.                done := true
  138.            else
  139.                i := succ(i)
  140.        until (matches > 1) or done;
  141.        if matches > 1 then
  142.            stat := ambiguous
  143.        else if (matches = 0) then
  144.            stat := unrec;
  145.        getsym := stat
  146.      end (* else *)
  147. end; (* getsym *)
  148.  
  149.  
  150.  
  151.  
  152.  
  153. FUNCTION parse(*: statustype*);
  154.  
  155. type states = (start, fin, get_filename, get_set_parm, get_parity, get_on_off,
  156.                get_esc_char, get_show_parm, get_help_show, get_help_parm,
  157.                exitstate, get_baud, get_wordlen, get_stopbit, get_xon_char,
  158.                get_xoff_char, get_xoffwait, get_nofeed, get_timeout, get_maxpak,
  159.                get_eoln_char, get_maxtry, get_prefix, get_dir);
  160.  
  161. var status: statustype;
  162.     word: vocab;
  163.     state: states;
  164.  
  165.            procedure case_start;
  166.  
  167.            begin
  168.              expected := [consym, exitsym, helpsym, phelpsym, quitsym, recsym,
  169.                           sendsym, setsym, showsym, pshowsym, dirsym, pdirsym];
  170.              status := getsym(verb);
  171.              if status = ateol then
  172.                begin
  173.                  parse := null;
  174.                  exit(parse)
  175.                end (* if *)
  176.              else if (status <> unrec) and (status <>  ambiguous) then
  177.                  case verb of
  178.                    consym, recsym, exitsym, quitsym: state := fin;
  179.                    helpsym         : begin
  180.                                        state := get_help_parm;
  181.                                        pr_out:= false
  182.                                      end;
  183.                    phelpsym        : begin
  184.                                        state := get_help_parm;
  185.                                        pr_out:= true
  186.                                      end;
  187.                    dirsym          : begin
  188.                                        state := get_dir;
  189.                                        pr_out := false;
  190.                                      end;
  191.                    pdirsym         : begin
  192.                                        state := get_dir;
  193.                                        pr_out := true;
  194.                                      end;
  195.                    sendsym         : state := getfilename;
  196.                    setsym          : state := get_set_parm;
  197.                    showsym         : begin
  198.                                        state := get_show_parm;
  199.                                        pr_out:= false
  200.                                      end;
  201.                    pshowsym        : begin
  202.                                        state := get_show_parm;
  203.                                        pr_out:= true
  204.                                      end;
  205.                  end (* case *)
  206.            end; (* case_start *)
  207.  
  208.  
  209.            procedure case_fin;
  210.  
  211.            begin
  212.              expected := [];
  213.              status := getsym(verb);
  214.              if status = ateol then
  215.                begin
  216.                  parse := null;
  217.                  exit(parse)
  218.                end (* if status *)
  219.              else
  220.                  status := unconfirmed
  221.            end; (* case_fin *)
  222.  
  223.  
  224.            procedure case_getfilename;
  225.  
  226.            begin
  227.              expected := [];
  228.              if getfn(line,xfilename,23) then
  229.                begin
  230.                  status := null;
  231.                  state := fin
  232.                end (* if *)
  233.              else
  234.                  status := fnexpected
  235.            end; (* case_getfilename *)
  236.  
  237.  
  238.            procedure case_gtprefixname;
  239.  
  240.            begin
  241.              expected := [];
  242.              if getfn(line,newprefix_vol,8) then
  243.                begin
  244.                  status := null;
  245.                  state := fin
  246.                end
  247.              else
  248.                   status := pnexpected
  249.            end;  (* case_gtprefixname *)
  250.  
  251.  
  252.            procedure case_getsetparm;
  253.  
  254.            begin
  255.              expected := [paritysym, localsym, ibmsym, escsym, prefixsym,
  256.                           wordlensym, stopbsym, delsym, debugsym, filewarnsym,
  257.                           baudsym, xonsym, xoffsym, xoffwaitsym, nofeedsym,
  258.                           timeoutsym, eolnsym, maxtrysym, emulatesym, maxpsym,
  259.                           textfsym, rejectsym];
  260.              status := getsym(noun);
  261.              if status = ateol then
  262.                  status := parm_expected
  263.              else if (status <> unrec) and (status <>  ambiguous) then
  264.                  case noun of
  265.                    paritysym:   state := get_parity;
  266.                    prefixsym:   state := get_prefix;
  267.                    escsym:      state := get_esc_char;
  268.                    baudsym:     state := get_baud;
  269.                    wordlensym:  state := get_wordlen;
  270.                    stopbsym:    state := get_stopbit;
  271.                    xonsym:      state := get_xon_char;
  272.                    xoffsym:     state := get_xoff_char;
  273.                    eolnsym:     state := get_eoln_char;
  274.                    xoffwaitsym: state := get_xoffwait;
  275.                    timeoutsym:  state := get_timeout;
  276.                    maxtrysym:   state := get_maxtry;
  277.                    maxpsym:     state := get_maxpak;
  278.                    nofeedsym, filewarnsym, debugsym, delsym, textfsym,
  279.                    ibmsym, localsym, rejectsym, emulatesym:
  280.                                 state := get_on_off;
  281.                  end (* case *)
  282.            end; (* case_getsetparm *)
  283.  
  284.  
  285.            procedure case_getparity;
  286.  
  287.            begin
  288.              expected := [marksym, spacesym, nonesym, evensym, oddsym];
  289.              status := getsym(adj);
  290.              if status = ateol then
  291.                  status := parm_expected
  292.              else if (status <> unrec) and (status <> ambiguous) then
  293.                  state := fin
  294.            end; (* case_getparity  *)
  295.  
  296.  
  297.            procedure case_getnum( var newnum : integer );
  298.  
  299.            begin
  300.              expected := [];
  301.              if get_num( line, newnum ) then
  302.                begin
  303.                  status := null; state := fin
  304.                end
  305.              else status := num_expected
  306.            end; (* case_getnum *)
  307.  
  308.  
  309.            procedure case_getonoff;
  310.  
  311.            begin
  312.              expected := [onsym, offsym];
  313.              status := getsym(adj);
  314.              if status = ateol then
  315.                  status := parm_expected
  316.              else if (status <> unrec) and (status <> ambiguous) then
  317.                  state := fin
  318.            end; (* case_ getonoff *)
  319.  
  320.  
  321.            procedure case_getchar( var newchar : char );
  322.  
  323.            begin
  324.              if nextch(newchar) then
  325.                 state := fin
  326.              else
  327.                 status := ch_expected;
  328.            end; (* case_getchar *)
  329.  
  330.  
  331.            procedure case_gtshowparm;
  332.  
  333.            begin
  334.              expected := [allsym, paritysym, localsym, ibmsym, prefixsym,
  335.                           wordlensym, stopbsym, escsym, delsym, debugsym,
  336.                           filewarnsym, baudsym, xonsym, xoffsym, xoffwaitsym,
  337.                           nofeedsym, timeoutsym, eolnsym, emulatesym, maxpsym,
  338.                           maxtrysym, textfsym, rejectsym];
  339.              status := getsym(noun);
  340.              if status = ateol then
  341.                  status := parm_expected
  342.              else if (status <> unrec) and (status <>  ambiguous) then
  343.                  state := fin
  344.            end; (* case_gtshowparm *)
  345.  
  346.  
  347.            procedure case_gethelpshow;
  348.  
  349.            begin
  350.              expected := [paritysym, localsym, ibmsym, escsym, delsym,
  351.                           wordlensym, stopbsym, debugsym, filewarnsym,
  352.                           baudsym, xonsym, xoffsym, xoffwaitsym, emulatesym,
  353.                           nofeedsym, timeoutsym, eolnsym, prefixsym, maxpsym,
  354.                           maxtrysym, textfsym, rejectsym];
  355.              status := getsym(adj);
  356.              if (status = at_eol) then
  357.                begin
  358.                  status := null;
  359.                  state := fin
  360.                end
  361.              else if (status <> unrec) and (status <>  ambiguous) then
  362.                  state := fin
  363.            end; (* case_gethelpshow *)
  364.  
  365.  
  366.            procedure case_gthelpparm;
  367.  
  368.            begin
  369.              expected := [consym, exitsym, helpsym, phelpsym, quitsym, recsym,
  370.                           sendsym, setsym, showsym, pshowsym, dirsym, pdirsym];
  371.              status := getsym(noun);
  372.              if status = ateol then
  373.                begin
  374.                  parse := null;
  375.                  exit(parse)
  376.                end;
  377.              if (status <> unrec) and (status <>  ambiguous) then
  378.                  case noun of
  379.                    consym, sendsym, recsym,
  380.                    showsym, pshowsym, helpsym,
  381.                    phelpsym, exitsym, quitsym,
  382.                    dirsym, pdirsym            : state := fin;
  383.                    setsym                     : state := get_help_show;
  384.                  end (* case *)
  385.            end; (* case_gthelpparm *)
  386.  
  387.  
  388. begin  (*  parse  *)
  389.   state   := start;
  390.   parse   := null;
  391.   noun    := nullsym;
  392.   verb    := nullsym;
  393.   adj     := nullsym;
  394.   uppercase ( line );
  395.   repeat
  396.     case state of
  397.       start         : case_start;
  398.       fin           : case_fin;
  399.       get_filename  : case_getfilename;
  400.       get_prefix    : case_gtprefixname;
  401.       get_set_parm  : case_getsetparm;
  402.       get_parity    : case_getparity;
  403.       get_baud      : case_getnum( newbaud );
  404.       get_wordlen   : case_getnum( newdbit );
  405.       get_stopbit   : case_getnum( newstopbit );
  406.       get_xoffwait  : case_getnum( newxoffwait);
  407.       get_timeout   : case_getnum( newtimeout );
  408.       get_maxtry    : case_getnum( newmaxtry );
  409.       get_maxpak    : case_getnum( newmaxpack );
  410.       get_dir       : case_getnum( vol_num );
  411.       get_on_off    : case_getonoff;
  412.       get_esc_char  : case_getchar( newescchar );
  413.       get_xon_char  : case_getchar( newxonchar );
  414.       get_xoff_char : case_getchar( newxoffchar);
  415.       get_eoln_char : case_getchar( newxeol_char );
  416.       get_show_parm : case_gtshowparm;
  417.       get_help_show : case_gethelpshow;
  418.       get_help_parm : case_gthelpparm;
  419.     end;  { case }
  420.   until (status <> null);
  421.   parse := status
  422. end; (* parse *)
  423.  
  424.  
  425. BEGIN  { initialization }
  426.   vocablist[allsym]      := 'ALL';
  427.   vocablist[baudsym]     := 'BAUD';
  428.   vocablist[consym]      := 'CONNECT';
  429.   vocablist[debugsym]    := 'DEBUG';
  430.   vocablist[delsym]      := 'DELKEY';
  431.   vocablist[dirsym]      := 'DIRECTORY';
  432.   vocablist[emulatesym]  := 'EMULATE';
  433.   vocablist[eolnsym]     := 'END-OF-LINE';
  434.   vocablist[escsym]      := 'ESCAPE';
  435.   vocablist[evensym]     := 'EVEN';
  436.   vocablist[exitsym]     := 'EXIT';
  437.   vocablist[filewarnsym] := 'FILE-WARNING';
  438.   vocablist[helpsym]     := 'HELP';
  439.   vocablist[ibmsym]      := 'IBM';
  440.   vocablist[localsym]    := 'LOCAL-ECHO';
  441.   vocablist[marksym]     := 'MARK';
  442.   vocablist[maxpsym]     := 'MAXPACK';
  443.   vocablist[maxtrysym]   := 'MAXTRY';
  444.   vocablist[nofeedsym]   := 'NOFEED';
  445.   vocablist[nonesym]     := 'NONE';
  446.   vocablist[oddsym]      := 'ODD';
  447.   vocablist[offsym]      := 'OFF';
  448.   vocablist[onsym]       := 'ON';
  449.   vocablist[paritysym]   := 'PARITY';
  450.   vocablist[pdirsym]     := 'PDIRECTORY';
  451.   vocablist[phelpsym]    := 'PHELP';
  452.   vocablist[prefixsym]   := 'PREFIX';
  453.   vocablist[pshowsym]    := 'PSHOW';
  454.   vocablist[quitsym]     := 'QUIT';
  455.   vocablist[recsym]      := 'RECEIVE';
  456.   vocablist[rejectsym]   := 'REJECT';
  457.   vocablist[sendsym]     := 'SEND';
  458.   vocablist[setsym]      := 'SET';
  459.   vocablist[showsym]     := 'SHOW';
  460.   vocablist[spacesym]    := 'SPACE';
  461.   vocablist[stopbsym]    := 'STOPBIT';
  462.   vocablist[textfsym]    := 'TEXTFILE';
  463.   vocablist[timeoutsym]  := 'TIMEOUT';
  464.   vocablist[wordlensym]  := 'WORD-LENGTH';
  465.   vocablist[xoffsym]     := 'XOFF-CHAR';
  466.   vocablist[xoffwaitsym] := 'XOFF-WAIT-COUNT';
  467.   vocablist[xonsym]      := 'XON-CHAR';
  468.   first_sym := allsym;
  469.   last_sym  := xonsym;
  470. END. (* end of unit parser *)
  471.  
  472.