home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 08 / strukto / strukto3.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1987-05-26  |  20.2 KB  |  466 lines
  1. (* ----------------------------------------------------------------------- *)
  2. (*                            STRUKTO3.PAS                                 *)
  3. (*                  Pascal-Quell-Datei verarbeiten                         *)
  4. (* ----------------------------------------------------------------------- *)
  5. PROCEDURE Source_bearbeiten;
  6. VAR Wort, Wort_norm, Dummy, Begriff : Text110;  Source_Zeile : Text255;
  7.     Verteiler: INTEGER; Source_File: TEXT; File_Ende, Dummy1, skip : BOOLEAN;
  8.   (* --------------------------------------------------------------------- *)
  9.   PROCEDURE Lies_Zeile (VAR Satz : Text255);
  10.   TYPE Kommentar = Text2;
  11.   VAR  Ort : INTEGER;
  12.     (* ------------------------------------------------------------------- *)
  13.     FUNCTION Loesche (Satz : Text255) : Text255;
  14.     CONST Anfu = '''';
  15.     VAR Ort, von, bis  : INTEGER;    Anfu_exist : BOOLEAN;
  16.         Verbleib, Test : Text110;    Such       : Text2;
  17.     BEGIN
  18.       Verbleib := '';  Ort := Pos (Anfu, Satz);  Anfu_exist := (Ort > 0);
  19.       IF (Pos ('{', Satz) < Ort) OR (Pos ('(*', Satz) < Ort) THEN
  20.         Anfu_exist := FALSE;
  21.       REPEAT
  22.         IF Anfu_exist THEN
  23.           BEGIN Test := Copy (Satz, 1, Ort);  Delete (Satz, 1, Ort); END
  24.         ELSE BEGIN Test := Satz;  Satz := ''; END;
  25.         REPEAT
  26.           Such := '}';  von := Pos ('(*', Test);
  27.           IF von = 0 THEN von := Pos ('{', Test) ELSE Such := '*)';
  28.           bis := Pos (Such, Test);
  29.           IF ((Ort > von) AND (von > 0)) AND ((Ort < bis) OR (bis = 0)) THEN
  30.             Anfu_exist := FALSE;
  31.           IF bis > 0 THEN Delete (Test, von, bis - von + Length (Such))
  32.           ELSE IF von > 0 THEN
  33.             BEGIN
  34.               Delete (Test, von, Length(Test));   von := 0;
  35.               REPEAT
  36.                 IF Satz = '' THEN
  37.                   BEGIN
  38.                     ReadLn(Quell_datei, Satz); File_Ende := Eof(Quell_datei);
  39.                   END;
  40.                 bis := Pos (Such, Satz);
  41.                 IF bis = 0 THEN Satz := '';
  42.               UNTIL bis > 0;
  43.               Delete(Satz, 1, bis + Length(Such) - 1);
  44.               bis := 0;  Ort := Pos(Anfu,Satz);
  45.             END;
  46.           IF Anfu_exist THEN
  47.             BEGIN
  48.               Ort := Pos (Anfu, Satz);  Test := Test + Copy (Satz, 1, Ort);
  49.               Delete (Satz, 1, Ort);    Ort  := Pos (Anfu, Satz);
  50.             END;
  51.           Anfu_exist := (Ort > 0);
  52.         UNTIL von + bis = 0;
  53.         Verbleib := Verbleib + Test;
  54.       UNTIL Test = '';
  55.       Loesche := Verbleib;
  56.     END; (* Loesche *)
  57.     (* ------------------------------------------------------------------- *)
  58.   BEGIN (* Lies_Zeile *)
  59.     REPEAT
  60.       ReadLn (Quell_datei, Satz);  File_Ende := Eof (Quell_datei);
  61.       Satz := Loesche (Satz);      Ort := 1;
  62.       WHILE Satz [Ort] = ' ' DO  Ort := Succ (Ort);
  63.       Delete (Satz, 1, Ort - 1);   Ort := Length (Satz);
  64.       WHILE Satz [Ort] = ' ' DO  Ort := Pred (Ort);
  65.       Delete (Satz, Ort + 1, Length(satz));
  66.     UNTIL (Length (Satz) > 1) OR File_Ende;
  67.   END; (* Lies_Zeile *)
  68.   (* --------------------------------------------------------------------- *)
  69.   PROCEDURE Wort_finden (VAR Satz : Text255;
  70.                          VAR Wort_gross, Wort_norm : Text110;
  71.                          VAR Begrenzer : BOOLEAN);
  72.   VAR   Ende, Anfuehrungs_Zeichen : BOOLEAN;
  73.         k : CHAR;   Zaehler : INTEGER;   Zwischen : Text255;
  74.   BEGIN
  75.     REPEAT
  76.       Zaehler := 1;  Anfuehrungs_Zeichen := FALSE;
  77.       WHILE Satz [Zaehler] = ' ' DO  Zaehler := Succ (Zaehler);
  78.       Delete(Satz,1,Zaehler-1); Zaehler:=1; Wort_gross:=''; Wort_norm:='';
  79.       REPEAT
  80.         k := Satz [Zaehler];
  81.         IF k = '''' THEN Anfuehrungs_Zeichen := NOT (Anfuehrungs_Zeichen);
  82.         Begrenzer := NOT (Anfuehrungs_Zeichen) AND
  83.                      ((k = ';') OR ((Wort_gross = 'END') AND (k = '.')));
  84.         Ende := Begrenzer OR (NOT (Anfuehrungs_Zeichen) AND (k = ' '));
  85.         IF NOT Ende THEN
  86.           BEGIN
  87.             Wort_gross := Wort_gross + UpCase (k);
  88.             Wort_norm := Wort_norm + k;  Zaehler := Succ (Zaehler);
  89.           END;
  90.         IF Zaehler >= Length (Satz) THEN
  91.           BEGIN  Lies_Zeile (Zwischen); Satz := Satz + ' ' + Zwischen;  END;
  92.       UNTIL Ende;
  93.       Delete (Satz, 1, Zaehler);
  94.     UNTIL (Wort <> '') OR OF_Fall OR File_Ende OR Ende;
  95.   END;    (* Wort_finden *)
  96.   (* --------------------------------------------------------------------- *)
  97.   FUNCTION Wort_isolieren(VAR Source_Satz: Text255; Suche: Text110): Text110;
  98.   VAR  Ausdruck: Text110;  Begrenzer: BOOLEAN;  Ort, Zahl, Fehler: INTEGER;
  99.   BEGIN
  100.     Ausdruck := '';
  101.     REPEAT
  102.       Wort_finden (Source_Satz, Wort, Wort_norm, Begrenzer);
  103.       IF Begrenzer THEN Source_Satz := ' ; ' + Source_Satz;
  104.       Begrenzer := (Wort = Suche);   Ort := Pos (Suche, Wort);
  105.       Val (Copy (Wort, 1, Ort - 1), Zahl, Fehler);
  106.       IF (Ort > 1) AND (Fehler = 0) THEN
  107.         BEGIN
  108.           Delete (Wort_norm, Ort, Length (Suche));
  109.           Source_Satz := Suche + ' ' + Source_Satz;
  110.         END;
  111.       IF NOT (Begrenzer) THEN Ausdruck := Ausdruck + ' ' + Wort_norm;
  112.     UNTIL Begrenzer;
  113.     Wort_isolieren := Ausdruck;
  114.   END; (* Wort_isolieren *)
  115.   (* --------------------------------------------------------------------- *)
  116.   PROCEDURE Case_Fall (VAR Source_Satz : Text255); FORWARD;
  117.   (* --------------------------------------------------------------------- *)
  118.   PROCEDURE Verteile_Schluessel (Begriff : Text110;
  119.                                  VAR Anweisungs_Ende : BOOLEAN); FORWARD;
  120.   (* --------------------------------------------------------------------- *)
  121.   PROCEDURE Ende (VAR Source_Satz : Text255); FORWARD;
  122.   (* --------------------------------------------------------------------- *)
  123.   PROCEDURE Schreibe_Struktur (Zeichen : Text2; Aussage : Text110);
  124.   BEGIN
  125.     IF STG_Schreiben THEN WriteLn (STG_Datei, Zeichen : 2, Aussage);
  126.     IF Druck_Ziel <> ohne THEN
  127.       BEGIN
  128.         WITH Struktur^ DO
  129.         BEGIN
  130.           Symbol := Zeichen;  Bezeichnung :=  Copy (Aussage, 2, 255);
  131.           IF Length (Symbol) > 1 THEN Symbol_schliessen (Symbol [2])
  132.           ELSE Symbol_auf (Symbol);
  133.         END;
  134.         Zeile := Zeile + 1;
  135.       END;
  136.   END; (* Schreibe_Struktur *)
  137.   (* --------------------------------------------------------------------- *)
  138.   PROCEDURE Schleife_beginnt (Zeichen : CHAR);
  139.   VAR Schluessel, Dummy : BOOLEAN;  Zwischen : Blockzeiger;
  140.   BEGIN
  141.     Block^.Zeichen := Zeichen;  Zwischen := Block;
  142.     New (Block);  Block^.Last := Zwischen;
  143.     REPEAT
  144.       Wort_finden (Source_Zeile, Wort, Wort_norm, Dummy);
  145.       Schluessel := (Wort='END');
  146.       IF NOT Schluessel THEN Verteile_Schluessel (Wort, Dummy);
  147.     UNTIL Schluessel;
  148.     Ende (Source_Zeile);
  149.   END; (* Schleife_beginnt *)
  150.   (* --------------------------------------------------------------------- *)
  151.   PROCEDURE Naechstes_Wort (Zeichen : CHAR; VAR Source_Satz : Text255);
  152.   VAR   Anweisungs_Ende : BOOLEAN;  Zwischen : Blockzeiger;
  153.   BEGIN
  154.     Wort_finden (Source_Satz, Wort, Wort_norm, Anweisungs_Ende);
  155.     IF Wort = 'BEGIN' THEN Schleife_beginnt (Zeichen)
  156.     ELSE
  157.       BEGIN
  158.         Block^.Zeichen := Zeichen;  Zwischen := Block;  New (Block);
  159.         Block^.Last := Zwischen; Verteile_Schluessel (Wort, Anweisungs_Ende);
  160.         Block := Block^.Last;     Zeichen := Block^.Zeichen;
  161.         Wort_finden (Source_Satz, Wort, Wort_norm, Anweisungs_Ende);
  162.         IF Anweisungs_Ende THEN Source_Satz := Wort_norm + ';' + Source_Satz
  163.         ELSE Source_Satz := Wort_norm + ' ' + Source_Satz;
  164.         IF (Zeichen = 'I') AND  (Wort <> 'ELSE') OR (Zeichen <> 'I') THEN
  165.           IF Zeichen = 'O' THEN Case_Fall (Source_Satz)
  166.           ELSE
  167.             BEGIN
  168.               IF Zeichen = 'E' THEN Zeichen := 'I';
  169.               IF Zeichen <> 'M' THEN Schreibe_Struktur ('#' + Zeichen, ' ');
  170.             END;
  171.       END;
  172.   END; (* Naechstes_Wort *)
  173.   (* --------------------------------------------------------------------- *)
  174.   FUNCTION Begriff_Check (Begriff : Text110) : INTEGER;
  175.   VAR  i : INTEGER;  Treffer : BOOLEAN;
  176.   BEGIN
  177.     i := 1;  Treffer := FALSE;
  178.     WHILE NOT (Treffer) AND (i <> 0) DO
  179.       IF Schluessel [i].Key = Begriff THEN Treffer := TRUE
  180.       ELSE IF Schluessel [i].Key > Begriff THEN i := Schluessel [i].Last
  181.       ELSE i := Schluessel [i].Next;
  182.     Begriff_Check := i;
  183.   END; (* Begriff_Check *)
  184.   (* --------------------------------------------------------------------- *)
  185.   PROCEDURE Prog_Proc_Fkt (VAR  Source_Satz : Text255; Overlays : BOOLEAN);
  186.   VAR  Titel    : Text110;       Dummy : BOOLEAN;
  187.        Zwischen : Namezeiger;    Ort   : INTEGER;
  188.   BEGIN
  189.     IF Overlays THEN Wort_finden (Source_Satz, Wort, Titel, Dummy);
  190.     Wort_finden (Source_Satz, Wort, Titel, Dummy);  Ort := Pos ('(', Titel);
  191.     IF Ort > 0 THEN Delete (Titel, Ort, Length(Titel));
  192.     Titel_Zeiger^.Block := 'P';  Titel_Zeiger^.Name  := ' ' + Titel;
  193.     Zwischen := Titel_Zeiger;  New (Titel_Zeiger);
  194.     Titel_Zeiger^.Last  := Zwischen;
  195.     REPEAT
  196.       Wort_finden (Source_Satz, Wort, Wort_norm, Dummy);
  197.       IF (Wort = 'FORWARD') OR (Wort = 'EXTERNAL') THEN
  198.         Titel_Zeiger := Titel_Zeiger^.Last;
  199.     UNTIL (Wort = 'BEGIN') OR (Wort = 'PROCEDURE') OR (Wort = 'FUNCTION');
  200.     IF Dummy THEN Source_Satz := Wort_norm + ';' + Source_Satz
  201.     ELSE Source_Satz := Wort_norm + ' ' + Source_Satz;
  202.   END; (* Prog_Proc_Fkt *)
  203.   (* --------------------------------------------------------------------- *)
  204.   PROCEDURE Ausdruck (VAR Source_Satz : Text255);
  205.   VAR  Schluessel, Anweisungs_Ende : BOOLEAN;
  206.        Anweisung : Text110;  Ort, i, Zahl : INTEGER;
  207.   BEGIN
  208.     Anweisung := '';
  209.     REPEAT
  210.       Wort_finden (Source_Satz, Wort, Wort_norm, Anweisungs_Ende);
  211.       Schluessel := (Wort = 'END') OR (Wort = 'ELSE') OR (Wort = 'UNTIL');
  212.       IF NOT (Schluessel) THEN Anweisung := Anweisung + ' ' + Wort_norm;
  213.     UNTIL Schluessel OR Anweisungs_Ende OR File_Ende;
  214.     Ort := Pos (':=', Anweisung);  Zahl := 0;
  215.     FOR i := 1 TO Ort DO IF Anweisung [i] = '''' THEN Zahl := Succ (Zahl);
  216.     IF Odd (Zahl) OR (Ort = 0) THEN Schreibe_Struktur ('U', Anweisung)
  217.     ELSE Schreibe_Struktur ('A', Anweisung);
  218.     IF Schluessel THEN Source_Satz := Wort + ' ' + Source_Satz;
  219.   END; (* Ausdruck *)
  220.   (* --------------------------------------------------------------------- *)
  221.   PROCEDURE Beginn;
  222.   VAR  Zwischen : Blockzeiger;  Name : Text110;
  223.   BEGIN
  224.     IF Titel_Zeiger^.Last = NIL THEN
  225.       BEGIN  Name := ' '; Block^.Zeichen := ' ';  END
  226.     ELSE
  227.       BEGIN
  228.         Titel_Zeiger := Titel_Zeiger^.Last; Name := Titel_Zeiger^.Name;
  229.         Block^.Zeichen := Titel_Zeiger^.Block;
  230.       END;
  231.     Schreibe_Struktur (Block^.Zeichen, Name);   Zwischen := Block;
  232.     New (Block);  Block^.Last := Zwischen;
  233.   END; (* Beginn *)
  234.   (* --------------------------------------------------------------------- *)
  235.   PROCEDURE Ende;
  236.   VAR  Zeichen : CHAR;  Anweisungs_Ende : BOOLEAN;
  237.   BEGIN
  238.     IF Block^.Last = NIL THEN Zeichen := ' '
  239.     ELSE BEGIN  Block := Block^.Last; Zeichen := Block^.Zeichen;  END;
  240.     IF Zeichen <> 'M' THEN
  241.       BEGIN
  242.         Wort_finden (Source_Satz, Wort, Wort_norm, Anweisungs_Ende);
  243.         IF Anweisungs_Ende THEN Source_Satz := Wort_norm + ';' + Source_Satz
  244.         ELSE Source_Satz := Wort_norm + ' ' + Source_Satz;
  245.         IF (Zeichen = 'I') AND (Wort <> 'ELSE') OR (Zeichen <> 'I') THEN
  246.           IF Zeichen = 'O' THEN Case_Fall (Source_Satz)
  247.           ELSE IF Zeichen = 'E' THEN Schreibe_Struktur ('#I', ' ')
  248.           ELSE Schreibe_Struktur ('#' + Zeichen, ' ');
  249.       END;
  250.   END; (* Ende *)
  251.   (* --------------------------------------------------------------------- *)
  252.   PROCEDURE If_Then_Else (VAR Source_Satz : Text255);
  253.   VAR  Schluessel : BOOLEAN;
  254.   BEGIN
  255.     Schreibe_Struktur ('I', Wort_isolieren (Source_Satz, 'THEN'));
  256.     Schreibe_Struktur ('T', ' ');  Naechstes_Wort ('I', Source_Satz);
  257.     Wort_finden (Source_Satz, Wort, Wort_norm, Schluessel);
  258.     IF Wort = 'ELSE' THEN
  259.       BEGIN
  260.         Schreibe_Struktur ('E', ' '); Naechstes_Wort ('E', Source_Satz);
  261.       END
  262.     ELSE IF Schluessel THEN Source_Satz := Wort_norm + ';' + Source_Satz
  263.     ELSE Source_Satz := Wort_norm + ' ' + Source_Satz;
  264.   END; (* If_Then_Else *)
  265.   (* --------------------------------------------------------------------- *)
  266.   PROCEDURE Case_Of (VAR Source_Satz : Text255);
  267.   VAR Verteiler : Text110;  Schluessel : BOOLEAN;  Zwischen : Blockzeiger;
  268.   BEGIN
  269.     Verteiler := '';
  270.     REPEAT
  271.       Wort_finden (Source_Satz, Wort, Wort_norm, Schluessel);
  272.       Schluessel := (Wort = 'OF');
  273.       IF NOT (Schluessel) THEN Verteiler := Verteiler + ' ' + Wort_norm;
  274.     UNTIL Schluessel;
  275.     Schreibe_Struktur ('C', Verteiler);  Block^.Zeichen := 'C';
  276.     Zwischen := Block;  New (Block);  Block^.Last := Zwischen;
  277.     Case_offen := TRUE;  Case_Fall (Source_Satz);
  278.   END; (* Case_Of *)
  279.   (* --------------------------------------------------------------------- *)
  280.   PROCEDURE Case_Fall;
  281.   VAR Begriff : Text110;  Schluessel, Semikolon : BOOLEAN;  Ort : INTEGER;
  282.   BEGIN
  283.     Begriff := '';
  284.     REPEAT
  285.       Wort_finden (Source_Satz, Wort, Wort_norm, Semikolon);
  286.       Schluessel := (Wort = ':');  Ort := Pos (':', Wort);
  287.       IF Ort > 1 THEN
  288.         BEGIN
  289.           IF Semikolon THEN Wort_norm := Wort_norm + ';';
  290.           Source_Satz := ': ' + Copy(Wort_norm, Ort + 1, 255) + ' ' + Source_Satz;
  291.           Delete (Wort_norm, Ort, Length(Wort_norm));
  292.         END;
  293.       IF NOT (Schluessel) THEN Begriff := Begriff + ' ' + Wort_norm;
  294.     UNTIL Schluessel OR (Wort = 'ELSE') OR (Wort = 'END');
  295.     IF Wort <> 'END' THEN
  296.       BEGIN
  297.         Schreibe_Struktur ('O', Begriff);  OF_Fall := TRUE;
  298.         Naechstes_Wort ('O', Source_Satz); OF_Fall := FALSE;
  299.       END
  300.     ELSE
  301.       BEGIN  Case_offen := FALSE;  Ende (Source_Satz);  END;
  302.   END; (* Case_Fall *)
  303.   (* --------------------------------------------------------------------- *)
  304.   PROCEDURE While_do (VAR Source_Satz : Text255);
  305.   BEGIN
  306.     Schreibe_Struktur ('W', Wort_isolieren (Source_Satz, 'DO'));
  307.     Naechstes_Wort ('W', Source_Satz);
  308.   END; (* While_do *)
  309.   (* --------------------------------------------------------------------- *)
  310.   PROCEDURE For_do (VAR Source_Satz : Text255);
  311.   VAR Variable, Beginn, Ende, Var1, Indikator : Text110;
  312.       Zahl, Fehler : INTEGER;  Dummy, Schluessel : BOOLEAN;
  313.   BEGIN
  314.     Wort_finden (Source_Satz, Wort, Variable, Dummy);
  315.     Zahl := Pos (':=', Variable);
  316.     IF Zahl > 0 THEN
  317.       BEGIN
  318.         Delete (Variable, Zahl, 2);
  319.         Source_Satz  := Copy (Variable, Zahl, 255) + ' ' + Source_Satz;
  320.         Delete (Variable, Zahl, Length(Variable));
  321.       END
  322.     ELSE
  323.       BEGIN
  324.         Wort_finden (Source_Satz, Wort, Var1, Dummy);
  325.         Source_Satz := Copy (Var1, 3, 255) + ' ' + Source_Satz;
  326.       END;
  327.     Beginn := '';
  328.     REPEAT
  329.       Wort_finden (Source_Satz, Indikator, Wort_norm, Schluessel);
  330.       Schluessel := (Indikator = 'TO') OR (Indikator = 'DOWNTO');
  331.       IF NOT (Schluessel) THEN Beginn := Beginn + ' ' + Wort_norm;
  332.     UNTIL Schluessel;
  333.     Ende := Wort_isolieren (Source_Satz, 'DO');  Zahl := 1;
  334.     WHILE Beginn [Zahl] = ' ' DO  Zahl := Succ (Zahl);
  335.     Delete (Beginn, 1, Zahl - 1);  Val (Beginn, Zahl, Fehler);
  336.     Var1 := Variable;  Variable := Variable + ' := ' + Variable;
  337.     IF Indikator = 'TO' THEN
  338.       BEGIN
  339.         IF Fehler = 0 THEN
  340.           BEGIN  Zahl := Zahl - 1;  Str (Zahl, Beginn);  END
  341.         ELSE Beginn := Beginn + ' - 1';
  342.         Variable := Variable + ' + 1';  Ende := ' <' + Ende;
  343.       END
  344.     ELSE
  345.       BEGIN
  346.         IF Fehler = 0 THEN
  347.           BEGIN  Zahl := Zahl + 1;  Str (Zahl, Beginn);  END
  348.         ELSE Beginn := Beginn + ' + 1 ';
  349.         Variable := Variable + ' - 1';  Ende := ' >' + Ende;
  350.       END;
  351.     Ende := Var1 + Ende;
  352.     Schreibe_Struktur ('A', ' ' + Var1 + ' := ' + Beginn);
  353.     Schreibe_Struktur ('W', ' ' + Ende);
  354.     Schreibe_Struktur ('A', ' ' + Variable);
  355.     Naechstes_Wort ('W', Source_Satz);
  356.   END; (* For *)
  357.   (* --------------------------------------------------------------------- *)
  358.   PROCEDURE Repeat_Until (VAR Source_Satz : Text255);
  359.   VAR  Zwischen : Blockzeiger;  Ausdruck : Text110;  Ort : INTEGER;
  360.        Schluessel, Anweisungs_Ende : BOOLEAN;
  361.   BEGIN
  362.     Schreibe_Struktur ('R', ' ');  Block^.Zeichen  := 'R';
  363.     Zwischen := Block;  New (Block);  Block^.Last := Zwischen;
  364.     REPEAT
  365.       Wort_finden (Source_Zeile, Wort, Wort_norm, Anweisungs_Ende);
  366.       Schluessel := (Wort = 'UNTIL');  Ort := Pos ('UNTIL', Wort);
  367.       IF Ort > 1 THEN
  368.         BEGIN
  369.           Delete (Wort, Ort, 5);  Delete (Wort_norm, Ort, 5);
  370.           Source_Satz := 'UNTIL ' + Source_Satz;
  371.         END;
  372.       IF NOT Schluessel THEN Verteile_Schluessel (Wort, Anweisungs_Ende);
  373.     UNTIL Schluessel;
  374.     Ausdruck := '';  Block := Block^.Last;
  375.     REPEAT
  376.       Wort_finden (Source_Satz, Wort, Wort_norm, Anweisungs_Ende);
  377.       Schluessel := (Wort = 'END');
  378.       IF NOT (Schluessel) THEN Ausdruck := Ausdruck + ' ' + Wort_norm;
  379.     UNTIL Schluessel OR Anweisungs_Ende;
  380.     Schreibe_Struktur ('#R', Ausdruck);
  381.     IF Schluessel THEN Source_Satz := 'END ' + Source_Satz;
  382.   END; (* Repeat_Until *)
  383.   (* --------------------------------------------------------------------- *)
  384.   PROCEDURE With_do (VAR Source_Satz : Text255);
  385.   VAR Dummy : BOOLEAN;
  386.   BEGIN
  387.     REPEAT
  388.       Wort_finden (Source_Satz, Wort, Wort_norm, Dummy);
  389.     UNTIL Wort = 'DO';
  390.     Naechstes_Wort ('M', Source_Satz);
  391.   END; (* With_Do *)
  392.   (* --------------------------------------------------------------------- *)
  393.   PROCEDURE Go_to (VAR Source_Satz : Text255);
  394.   VAR Dummy : BOOLEAN;
  395.   BEGIN
  396.     Wort_finden (Source_Satz, Wort, Wort_norm, Dummy);
  397.     Wort_norm := ' GOTO ' + Wort_norm;  Schreibe_Struktur ('A', Wort_norm);
  398.   END; (* Go_To *)
  399.   (* --------------------------------------------------------------------- *)
  400.   PROCEDURE Verteile_Schluessel;
  401.   VAR Verteiler : INTEGER;
  402.   BEGIN
  403.     Verteiler := Begriff_Check (Begriff);
  404.     CASE Verteiler OF
  405.            1  : Prog_Proc_Fkt (Source_Zeile, TRUE);
  406.            2  : For_do (Source_Zeile);
  407.            3  : Repeat_Until (Source_Zeile);
  408.            4  : Case_Of (Source_Zeile);
  409.            5  : Go_to (Source_Zeile);
  410.            7  : While_do (Source_Zeile);
  411.            8  : Beginn;
  412.            9  : Ende (Source_Zeile);
  413.           11  : If_Then_Else (Source_Zeile);
  414.           13  : With_do (Source_Zeile);
  415.     6, 10,12  : Prog_Proc_Fkt (Source_Zeile, FALSE);
  416.            0  : BEGIN
  417.                   IF Anweisungs_Ende THEN
  418.                     Source_Zeile := Wort_norm + '; ' + Source_Zeile
  419.                   ELSE Source_Zeile := Wort_norm + ' ' + Source_Zeile;
  420.                   Ausdruck (Source_Zeile);
  421.                 END;
  422.     END;
  423.   END; (* Verteile_Schluessel *)
  424.   (* --------------------------------------------------------------------- *)
  425.   PROCEDURE Source_Init;
  426.   VAR  i  : INTEGER;
  427.   BEGIN
  428.     OF_Fall := FALSE;
  429.     REPEAT
  430.       Datei_Name (Source_Name, TRUE, 'Quell-Datei', 17);
  431.       Assign (Quell_datei, Source_Name);
  432.       {$I-}  ReSet (Quell_datei);  {$I+}   Datei_Status (Source_Name);
  433.     UNTIL Datei_ok OR (Length (Source_Name) < 2);
  434.     IF Length (Source_Name) > 1 THEN
  435.       BEGIN
  436.         IF STG_Schreiben THEN
  437.           BEGIN
  438.             Datei_Name (Struktur_Name, FALSE, 'Ausgabe-Datei', 17);
  439.             IF Struktur_Name = '' THEN
  440.               BEGIN
  441.                 i := Pos ('.', Source_Name);
  442.                 Struktur_Name := Copy (Source_Name, 1, i - 1);
  443.               END;
  444.             Assign (STG_Datei,  Struktur_Name + '.STG'); ReWrite (STG_Datei);
  445.           END;
  446.         New (Block);  Block^.Last := NIL;
  447.         New(Titel_Zeiger);  Titel_Zeiger^.Last  := NIL;
  448.       END;
  449.   END; (* Source_Init *)
  450.   (* --------------------------------------------------------------------- *)
  451. BEGIN
  452.   Source_Init;  Zeile := 1;
  453.   IF Datei_ok AND (Source_Name <> '') THEN
  454.     BEGIN
  455.       Init_Phase;  Lies_Zeile (Source_Zeile);
  456.       REPEAT
  457.         Wort_finden (Source_Zeile, Wort, Wort_norm, Dummy1);
  458.         Verteile_Schluessel (Wort, Dummy1);
  459.       UNTIL (Length (Source_Zeile) < 2) AND File_Ende;
  460.       IF STG_Schreiben THEN
  461.         BEGIN Close (STG_Datei); Zu_Lang := TRUE; END;
  462.       Nachlauf;
  463.     END;
  464. END; (* Source_bearbeiten *)
  465. (* ----------------------------------------------------------------------- *)
  466. (*                     Ende von STRUKTO3.PAS                               *)