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