home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 05 / ldm / parser.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-02-14  |  12.3 KB  |  412 lines
  1. {  ------------------------------------------------------  }
  2. {                       PARSER.PAS                         }
  3. {          (c) 1990  Siegfried Hund & TOOLBOX              }
  4. {  ------------------------------------------------------  }
  5. PROGRAM Parser;
  6.  
  7. USES Crt, Dos, Printer;
  8.  
  9. TYPE
  10.   Zeiger = ^Satz;
  11.   Satz   = RECORD
  12.              inhalt    : STRING [20];
  13.              ingross   : STRING [20];
  14.              naechster : zeiger;
  15.             END;
  16.  
  17. VAR
  18.   anfangszeiger              : zeiger;
  19.   hilfszeiger                : zeiger;
  20.   laufzeiger                 : zeiger;
  21.   datensatz                  : Satz;
  22.   datei, orgdatei            : STRING;
  23.   newdatei, pasdatei         : STRING;
  24.   parswort, verarb           : STRING;
  25.   textdatei                  : Text;
  26.   parsdatei                  : Text;
  27.   neuetextdatei              : Text;
  28.   ok, ok1                    : BOOLEAN;
  29.   ch, ch1, taste, lastch     : CHAR;
  30.   zeile, wort, grwort        : STRING;
  31.   textzeile                  : STRING;
  32.   x, y                       : BYTE;
  33.   i, tzlen                   : INTEGER;
  34.  
  35.   { Text schreiben an der Position x und y }
  36.  
  37.   PROCEDURE WriteXY(x, y : BYTE; txt : STRING);
  38.   BEGIN
  39.     GotoXY(x, y);
  40.     Write(txt);
  41.   END;
  42.  
  43.   PROCEDURE Maske;                 { Überschrift }
  44.   BEGIN
  45.     ClrScr;
  46.     WriteXY(1, 1, '   Pascal-Parser    Version 1.0   (C)' + 
  47.           '   1990  Siegfried Hund & TOOLBOX    ');
  48.   END;
  49.  
  50.   PROCEDURE DateiToHeap;
  51.   { Datei PARSPAS.TXT als vekettete Liste auf den Heap }
  52.   BEGIN
  53.     Assign(parsdatei, 'PARSPAS.TXT');
  54. {$I-}
  55.     Reset(parsdatei);
  56.     IF IOResult <> 0 THEN BEGIN
  57.       WriteLn;
  58.       WriteLn('Fehler:  Datei PARSPAS.TXT im Path ', 
  59.               'nicht vorhanden');
  60.       WriteLn;
  61.       WriteLn('Hinweis: Die Datei PARSPAS.TXT muß mit ', 
  62.               'dem Programm ');
  63.       WriteLn('         PARSER.EXE im gleichen Path ', 
  64.               'vorhanden sein.');
  65.       WriteLn;
  66.       WriteLn('Das Programm wird jetzt abgebrochen');
  67.       WriteLn;
  68.       Halt(1);
  69.     END;
  70. {$I+}
  71.     anfangszeiger := NIL;
  72.     While NOT EoF(parsdatei) DO BEGIN
  73.       New(hilfszeiger);
  74.       Read(parsdatei, parswort, ch, ch);
  75.       grwort := '';
  76.       FOR i := 1 TO Length(parswort) DO
  77.         grwort := grwort + UpCase(parswort[ i ]);
  78.       hilfszeiger^.ingross := grwort;
  79.       hilfszeiger^.naechster := NIL;
  80.       hilfszeiger^.inhalt := parswort;
  81.       grwort := '';
  82.       IF anfangszeiger = NIL THEN
  83.         anfangszeiger := hilfszeiger
  84.       ELSE BEGIN
  85.         laufzeiger := anfangszeiger;
  86.         While laufzeiger^.naechster <> NIL DO
  87.           laufzeiger := laufzeiger^.naechster;
  88.         laufzeiger^.naechster := hilfszeiger;
  89.       END;
  90.     END;
  91.   END;
  92.  
  93.   PROCEDURE ParamTest;
  94.   BEGIN
  95.     ok  := FALSE;
  96.     ok1 := FALSE;
  97.     IF ParamCount = 0 THEN BEGIN
  98.       GotoXY(1, 5);
  99.       Write('Path und Dateiname(ohne .PAS) : ');
  100.       Read(datei);
  101.       FOR i := 1 TO Length(datei) DO
  102.         datei[i] := UpCase(datei[i]);
  103.       ok := TRUE;
  104.     END;
  105.     IF ParamCount = 1 THEN BEGIN
  106.       datei := ParamStr(1);
  107.       ok := TRUE;
  108.     END;
  109.     IF ParamCount = 2 THEN BEGIN
  110.       datei := ParamStr(1);
  111.       ok := TRUE;
  112.       verarb := ParamStr(2);
  113.       taste := verarb[1];
  114.       taste := UpCase(taste);
  115.       IF taste IN ['d', 'D', 'f', 'F', 's', 'S'] THEN
  116.         ok1 := TRUE
  117.       ELSE
  118.         ok1 := FALSE;
  119.     END;
  120.     IF ok THEN BEGIN
  121.       ok := FALSE;
  122.       pasdatei := datei + '.PAS';
  123.       Assign(textdatei, pasdatei);
  124. {$I-}
  125.       Reset(textdatei);
  126.       IF IOResult <> 0 THEN BEGIN
  127.         WriteLn;
  128.         WriteLn('Fehler:  Datei ', pasdatei, 
  129.                 ' im Path nicht vorhanden');
  130.         WriteLn;
  131.         WriteLn('Hinweis: Programm erneut aufrufen ', 
  132.                 'und den richtigen ');
  133.         WriteLn('         Path und Dateinamen ohne ', 
  134.                 '.PAS angeben.     ');
  135.         WriteLn;
  136.         WriteLn('Das Programm wird jetzt abgebrochen');
  137.         WriteLn;
  138.         Halt(1);
  139.         WriteLn;
  140.         WriteLn('Datei im Path nicht vorhanden');
  141.         ok := FALSE;
  142.       END ELSE
  143.         ok := TRUE;
  144. {$I+}
  145.       IF ok1 = FALSE THEN BEGIN
  146.         WriteLn;
  147.         WriteLn('Verarbeitungs-Parameter fehlt         ');
  148.         WriteLn;
  149.         WriteLn('Zugelassene Parameter sind :   ');
  150.         WriteLn;
  151.         WriteLn('S    -->  Ausgabe nur auf dem Bildschirm');
  152.         WriteLn('D    -->  Ausgabe nur auf dem Drucker   ');
  153.         WriteLn('F    -->  Ausgabe in die Datei  *.PAS   ');
  154.         WriteLn;
  155.         Write('Parameter eingeben:  ');
  156.         REPEAT
  157.           taste := ReadKey;
  158.           taste := UpCase(taste);
  159.         UNTIL taste IN ['d', 'D', 'f', 'F', 's', 'S'];
  160.         Write(taste);
  161.         WriteLn;
  162.         ok1 := TRUE;
  163.       END;
  164.     END;
  165.   END;
  166.  
  167.   PROCEDURE PasToOrg;
  168.   { Die Datei xxx.PAS in XXX.ORG umbenennen }
  169.   BEGIN
  170.     IF ok THEN BEGIN
  171.       pasdatei := datei + '.PAS';
  172.       orgdatei := datei + '.ORG';
  173.       Rename(textdatei, orgdatei);
  174.       WriteLn('Die Datei ', pasdatei, ' wurde in Datei ', 
  175.               orgdatei, ' umbenannt ');
  176.       WriteLn;
  177.       Assign(textdatei, orgdatei);
  178. {$I-}
  179.       Reset(textdatei);
  180.       IF IOResult <> 0 THEN BEGIN
  181.         WriteLn;
  182.         WriteLn('Datei im Path nicht vorhanden');
  183.         WriteLn;
  184.         ok := FALSE;
  185.       END ELSE ok := TRUE;
  186. {$I+}
  187.     END;
  188.   END;
  189.  
  190.   PROCEDURE sauberlauf;
  191.   { Die Zeichen Klammer/Stern und Stern/Klammer für }
  192.   { Kommetare in geschweifte Klammern und die Zeichen }
  193.   { Klammer/Punkt und Punkt/Klammer in eckige Klammern }
  194.   { umwandeln. Der neue Pascal-Source wird in der }
  195.   { temporären Datei xxx.$$$ abgelegt. }
  196.   VAR
  197.     ntext  : STRING;
  198.     htext  : STRING;
  199.   BEGIN
  200.     IF ok THEN BEGIN
  201.       orgdatei := datei + '.ORG';
  202.       newdatei := datei + '.$$$';
  203.       Assign(neuetextdatei, newdatei);
  204.       Assign(textdatei, orgdatei);
  205. {$I-}
  206.       Rewrite(neuetextdatei);
  207.       Reset(textdatei);
  208.       IF IOResult <> 0 THEN BEGIN
  209.         WriteLn('Datei im Path nicht vorhanden');
  210.         WriteLn;
  211.         ok := FALSE;
  212.       END ELSE ok := TRUE;
  213. {$I+}
  214.       REPEAT
  215.         Read(textdatei, textzeile, ch, ch1);
  216.         { geschweifte Klammer auf, für Kommentare }
  217.         i := Pos('{ ', textzeile);
  218.         While i <> 0 DO  BEGIN
  219.           Delete(textzeile, i, 2);
  220.           Insert('{ ', textzeile, i);
  221.           i := Pos('{ ', textzeile);
  222.         END;
  223.         { geschweifte Klammer zu, für Kommentare }
  224.         i := Pos(' }', textzeile);
  225.         While i <> 0 DO BEGIN
  226.           Delete(textzeile, i, 2);
  227.           Insert(' }', textzeile, i);
  228.           i := Pos(' }', textzeile);
  229.         END;
  230.         { eckige Klammer auf }
  231.         i := Pos('[ ', textzeile);
  232.         While i <> 0 DO BEGIN
  233.           Delete(textzeile, i, 2);
  234.           Insert('[ ', textzeile, i);
  235.           i := Pos('[ ', textzeile);
  236.         END;
  237.         { eckige Klammer zu }
  238.         i := Pos(' ]', textzeile);
  239.         While i <> 0 DO BEGIN
  240.           Delete(textzeile, i, 2);
  241.           Insert(' ]', textzeile, i);
  242.           i := Pos(' ]', textzeile);
  243.         END;
  244.         Write(neuetextdatei, textzeile, ch, ch1);
  245.       UNTIL EoF(textdatei);
  246.       Close(neuetextdatei);
  247.       ok := TRUE;
  248.     END ELSE ok := FALSE;
  249.     IF ok THEN BEGIN
  250.       pasdatei := datei + '.PAS';
  251.       newdatei := datei + '.$$$';
  252.       Assign(textdatei, newdatei);
  253. {$I-}
  254.       Reset(textdatei);
  255.       IF IOResult <> 0 THEN BEGIN
  256.         WriteLn;
  257.         WriteLn('Datei im Path nicht vorhanden');
  258.         ok := FALSE;
  259.       END ELSE ok := TRUE;
  260. {$I+}
  261.     END;
  262.   END;
  263.  
  264.   PROCEDURE parspascal;
  265.   { Die Pascal-Schlüsselworte suchen und }
  266.   { in die richtige Schreibweise umsetzen }
  267.   BEGIN
  268.     hilfszeiger := anfangszeiger;
  269.     While (hilfszeiger <> NIL) AND
  270.           ( hilfszeiger^.ingross <> wort) DO
  271.       hilfszeiger := hilfszeiger^.naechster;
  272.     IF wort = hilfszeiger^.ingross THEN
  273.       zeile := hilfszeiger^.inhalt;
  274.   END;
  275.  
  276.   PROCEDURE Bearbeiten;
  277.   { Die Datei xxx.$$$ zeichenweise lesen, die Schlüssel-   }
  278.   { worte herausfiltern und ersetzen, sowie die            }
  279.   { Kommentarzeilen und die Texte in Hochkommata von einer }
  280.   { Umwandlung ausnehmen. Der neue Pascal-Source wird in   }
  281.   { der Datei xxx.PAS abgelegt. Bei der Bildschirmausgabe  }
  282.   { und Drucker-Ausgabe wird keine neue Datei xxx.PAS      }
  283.   { erzeugt. }
  284.   BEGIN
  285.     textzeile := '';
  286.     lastch := ' ';
  287.     IF taste = 'F' THEN BEGIN
  288.       Assign(neuetextdatei, pasdatei);
  289.       Rewrite(neuetextdatei);
  290.     END;
  291.     REPEAT
  292.       zeile := '';
  293.       REPEAT
  294.         Read(textdatei, ch);
  295.         IF (lastch = ',') AND (ch <> ' ') THEN BEGIN
  296.           textzeile := textzeile + ', ';
  297.           lastch := ' ';
  298.         END ELSE
  299.           IF (lastch = ',') AND (ch = ' ') THEN BEGIN
  300.             textzeile := textzeile + lastch;
  301.             lastch := ' ';
  302.           END;
  303.         IF (lastch = ':') AND (ch = '=') THEN BEGIN
  304.           tzlen := Length(textzeile);
  305.           IF textzeile[ tzlen ] <> ' ' THEN
  306.             textzeile := textzeile + ' ' + lastch + ch
  307.           ELSE
  308.             textzeile := textzeile + lastch + ch;
  309.           Read(textdatei, ch);
  310.           IF ch <> ' ' THEN BEGIN
  311.             textzeile := textzeile + ' ';
  312.             lastch := ' ';
  313.           END;
  314.         END ELSE
  315.           IF (lastch = ':') AND (ch <> '=') THEN BEGIN
  316.             textzeile := textzeile + lastch;
  317.             lastch := ' ';
  318.           END;
  319.         IF (lastch IN [ '+', '-', '*', '/' ]) THEN BEGIN
  320.           tzlen := Length(textzeile);
  321.           IF textzeile[ tzlen ] <> ' ' THEN
  322.             textzeile := textzeile + ' ' + lastch
  323.           ELSE
  324.             textzeile := textzeile + lastch;
  325.           IF ch <> ' ' THEN textzeile := textzeile + ' ';
  326.           IF ch =  ' ' THEN textzeile := textzeile;
  327.           lastch := ' ';
  328.         END;
  329.         While ch IN [ 'A'..'Z', 'a'..'z' ] DO BEGIN
  330.           zeile := zeile + ch;
  331.           Read(textdatei, ch);
  332.         END;
  333.         IF zeile > '' THEN BEGIN
  334.           wort := zeile;
  335.           FOR i := 1 TO Length(wort) DO
  336.             wort[i] := UpCase(wort[i]);
  337.           parspascal;
  338.           textzeile := textzeile + zeile;
  339.           zeile := '';
  340.         END;
  341.         IF ch = Chr(39) THEN BEGIN
  342.           textzeile := textzeile + ch;
  343.           REPEAT
  344.             Read(textdatei, ch);
  345.             textzeile := textzeile + ch;
  346.           UNTIL ch = Chr(39);
  347.           Read(textdatei, ch);
  348.         END;
  349.         IF ch = '{' THEN BEGIN
  350.           REPEAT
  351.             IF ch IN [ #13, #10 ] THEN BEGIN
  352.               CASE taste OF
  353.                 'S' : Write(textzeile);
  354.                 'D' : Write(Lst, textzeile);
  355.                 'F' : Write(neuetextdatei, textzeile);
  356.               END;
  357.               textzeile := '';
  358.             END;
  359.             textzeile := textzeile + ch;
  360.             Read(textdatei, ch);
  361.           UNTIL ch = '}';
  362.         END;
  363.         IF ch IN [',', '+', '-', '*', '/', ':'] THEN
  364.           lastch := ch
  365.         ELSE BEGIN
  366.           textzeile := textzeile + ch;
  367.           lastch := ' ';
  368.         END;
  369.       UNTIL ch IN [#13, #10];
  370.       CASE taste OF
  371.         'S' : Write(textzeile);
  372.         'D' : Write(Lst, textzeile);
  373.         'F' : Write(neuetextdatei, textzeile);
  374.       END;
  375.       textzeile := '';
  376.     UNTIL EoF(textdatei);
  377.     IF ok THEN Close(textdatei) ELSE Delay(2500);
  378.     IF taste = 'F' THEN Close(neuetextdatei);
  379.   END;
  380.  
  381. BEGIN
  382.   ClrScr;
  383.   Maske;
  384.   Window(1, 3, 80, 25);
  385.   ClrScr;
  386.   DateiToHeap;  { Parser-Datei auf Heap laden }
  387.   ParamTest;    { Parameter vorhanden ? }
  388.   PasToOrg;     { Rename xxx.PAS in xxx.ORG }
  389.   sauberlauf;   { Klammern korrigieren }
  390.   IF ok AND ok1 THEN BEGIN
  391.     Bearbeiten;
  392.     Erase(textdatei);
  393.     CASE taste OF
  394.       'S', 'D' : BEGIN
  395.                    Assign(textdatei, orgdatei);
  396.                    Rename(textdatei, pasdatei);
  397.                  END;
  398.       'F'      : BEGIN
  399.                    WriteLn('Die Originaldatei wurde in  ', 
  400.                            orgdatei, ' umbenannt');
  401.                    WriteLn('Die erzeugte Datei wurde als ', 
  402.                             pasdatei, ' gespeichert');
  403.                    WriteLn;
  404.                  END;
  405.     END;
  406.     WriteLn('Programm beendet');
  407.   END ELSE WriteLn('Das Programm wurde abgebrochen');
  408. END.
  409. {  ------------------------------------------------------  }
  410. {                 Ende von PARSER.PAS                      }
  411.  
  412.