home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / aeg020 / sps.inc < prev    next >
Encoding:
Text File  |  1990-02-01  |  6.9 KB  |  249 lines
  1.  
  2. procedure update_filename (ext : extension);
  3.  
  4. begin
  5.   if (ext <> '') then
  6.   begin
  7.     if (pos('.',filename) <> 0) then
  8.       delete(filename,pos('.',filename),12);
  9.     filename             := filename + '.' + ext;
  10.   end;
  11.   for i                  := 1 to length(filename) do
  12.     filename[i]          := upcase(filename[i]);
  13. end;
  14.  
  15.  
  16.  
  17. function exist (name: Dateiname) : boolean;
  18.  
  19. var
  20. test                     :  file;
  21.  
  22. begin
  23.   assign(test,name);
  24.   (*$I-*)
  25.   reset(test);
  26.   (*$I+*)
  27.   exist                  := (ioresult=0);
  28. end;
  29.  
  30.  
  31.  
  32. procedure syntax_check (s : awtyp);
  33.  
  34. var
  35. oende,
  36. pende,
  37. zende                    :  boolean;
  38. operationstr,
  39. operandstr,
  40. zahlstr                  :  awtyp;
  41.  
  42. begin
  43.   oende                  := false;
  44.   pende                  := false;
  45.   sende                  := false;
  46.   zende                  := false;
  47.   status                 := 0;
  48.   operationstr           := '';
  49.   operandstr             := '';
  50.   zahlstr                := '';
  51.  
  52.   for i                  := 1 to length(s) do
  53.   begin
  54.     case s[i] of
  55.       'A','M','T','Z',
  56.       'E','I'            :  if not pende then
  57.                             begin
  58.                               oende          := true;
  59.                               operandstr     := operandstr   + s[i];
  60.                             end
  61.                             else
  62.                               zahlstr        := zahlstr      + s[i];
  63.       'L'                :  if (operationstr[1] in ['S','R']) then
  64.                               operationstr   := operationstr + s[i]
  65.                             else
  66.                               if not pende then
  67.                               begin
  68.                                 oende        := true;
  69.                                 operandstr   := operandstr   + s[i];
  70.                               end
  71.                               else
  72.                                 zahlstr      := zahlstr      + s[i];
  73.  
  74.       '0'..'9'           :  begin
  75.                               pende          := true;
  76.                               zahlstr        := zahlstr      + s[i];
  77.                             end;
  78.     else
  79.       if not oende then
  80.         operationstr     := operationstr + s[i]
  81.       else
  82.         if not pende then
  83.           operandstr     := operandstr   + s[i]
  84.         else
  85.           zahlstr        := zahlstr      + s[i];
  86.  
  87.     end;
  88.   end;
  89.  
  90.   if (length(operationstr) = 0) then
  91.     status               := -3;
  92.  
  93.   if (status = 0) then
  94.   begin
  95.     j                    := 0;
  96.     for i                := 1 to maxoperationen do
  97.       if (operationstr = operationen[i]) then
  98.         j                := i;
  99.     if (j = 0) then
  100.       status             := -4
  101.     else
  102.       status             := 0;
  103.     if (j = 3) then
  104.       if (operandstr > '') then
  105.         status           := -5;
  106.     if (j < 6) then
  107.       sende              := true;
  108.     if (j > 9) then
  109.       zende              := true;
  110.     if (j = 10) and (operandstr[1] = 'E') then
  111.     begin
  112.       operationstr       := 'PE';
  113.       operandstr         := '';
  114.     end;
  115.     if (j = 12) then
  116.       klammern           := pred(klammern);
  117.     if (j > 12) then
  118.       klammern           := succ(klammern);
  119.  
  120.   end;
  121.  
  122.   if (status = 0) then
  123.   begin
  124.     if zende and ((length(operandstr) > 0) or (length(zahlstr) > 0)) then
  125.       status             := -5;
  126.     if not zende then
  127.       if (length(operandstr) = 0) and (j <> 3) then
  128.         status           := -7
  129.       else
  130.         if (length(zahlstr) = 0) then
  131.           status         := -9;
  132.   end;
  133.  
  134.   if (status = 0) and (j <> 3) and not zende then
  135.     if (length(operandstr)=1) and (operandstr[1] in ['E','A','M','T','Z','L','I']) then
  136.       status             := 0
  137.     else
  138.       status             := -6;
  139.  
  140.   if (status = 0) and not zende then
  141.   begin
  142.     status               := -8;
  143.     val(zahlstr,i,ii);
  144.     if (ii = 0) then
  145.     begin
  146.       status             := -10;
  147.       if (j <> 3) then
  148.       begin
  149.         case operandstr[1] of
  150.           'E'            :  if (i <= maxe) then
  151.                             begin
  152.                               status   := 0;
  153.                               if (maxopr[1] < i) then
  154.                                 maxopr[1]:= i;
  155.                             end;
  156.           'A'            :  if (i <= maxa) then
  157.                             begin
  158.                               status   := 0;
  159.                               if (maxopr[2] < i) then
  160.                                 maxopr[2]:= i;
  161.                             end;
  162.           'M'            :  if (i <= maxm) then
  163.                             begin
  164.                               status   := 0;
  165.                               if (maxopr[3] < i) then
  166.                                 maxopr[3]:= i;
  167.                             end;
  168.           'T'            :  if (i <= maxt) then
  169.                             begin
  170.                               status   := 0;
  171.                               if (maxopr[4] < i) then
  172.                                 maxopr[4]:= i;
  173.                             end;
  174.           'Z'            :  if (i <= maxz) then
  175.                             begin
  176.                               status   := 0;
  177.                               if (maxopr[5] < i) then
  178.                                 maxopr[5]:= i;
  179.                             end;
  180.           'I'            :  if (i <= maxz) then
  181.                             begin
  182.                               status   := 0;
  183.                               if (maxopr[6] < i) then
  184.                                 maxopr[6]:= i;
  185.                             end;
  186.           'L'            :  if (i <= maxz) then
  187.                             begin
  188.                               status   := 0;
  189.                               if (maxopr[7] < i) then
  190.                                 maxopr[7]:= i;
  191.                             end;
  192.         end;
  193.       end
  194.       else
  195.         if (i <= maxaw) then
  196.           status         := 0;
  197.     end;
  198.   end;
  199.  
  200.   if (status = 0) then
  201.   begin
  202.     with awl[anzaw] do
  203.     begin
  204.       operation          := operationstr;
  205.       if zende then
  206.       begin
  207.         operand          := '';
  208.         kennzahl         := -1;
  209.       end
  210.       else
  211.       begin
  212.         operand          := operandstr;
  213.         kennzahl         := i;
  214.       end;
  215.     end;
  216.     if (operationstr = 'PE') then
  217.       status             := 1;
  218.   end;
  219.   gotoxy (17, 4);
  220.   write  (' - ',operationstr,' ',operandstr,' ',zahlstr,' ');
  221. end;
  222.  
  223.  
  224.  
  225. procedure fehlerbehandlung;
  226.  
  227. begin
  228.   gotoxy ( 2, 6);
  229.   write  ('Fehler entdeckt - ');
  230.   writeln(fehlermeldung[abs(status)]);
  231.  
  232.   if (status < -2) then
  233.   begin
  234.     gotoxy ( 2, 8);
  235.     write  ('Neue Anweisung  : ');
  236.     readln (aw);
  237.     if (aw > ' ') then
  238.     begin
  239.       status             := 2;
  240.       anzaw              := pred(anzaw);
  241.       korrektur          := true;
  242.       gotoxy ( 1, 6);
  243.       clreol;
  244.       gotoxy ( 1, 8);
  245.       clreol;
  246.     end;
  247.   end;
  248. end;
  249.