Turbo Toolbox/Turbo_Toolbox.iso/spezial/05/pascal/strukto3.pas

Pascal/Delphi Source File | 1989-01-02 | 26.1 KB | 753 lines

(*----------------------------------------------------------------------*)
(*                       STRUKTO3.PAS                                   *)
(*              Pascal-Quell-Datei verarbeiten                          *)

procedure Source_bearbeiten;
var Wort, Wort_norm,
    Dummy, Begriff     : Text110;
    Source_Zeile       : Text255;
    Verteiler          : integer;
    Source_File        : text;
    File_Ende, Dummy1  : boolean;

  procedure Lies_Zeile (var Satz : Text255);
  type Kommentar = Text2;
  var  Ort       : integer;

     function Loesche (Satz : Text255) : Text255;
     const Anfu = '''';
     var Ort, Von, Bis  : integer;
         Verbleib, Test : Text110;
         Such           : Text2;
         Anfu_exist     : boolean;
     begin
       Verbleib   := '';
       Ort        := pos (Anfu, Satz);
       Anfu_exist := (Ort > 0);
       if (pos ('{', Satz) in [1..Ort]) or (pos ('(*', Satz) in [1..Ort])
         then Anfu_Exist := false;
       repeat
         if Anfu_exist
           then begin
                  Test := copy (Satz, 1, Ort);
                  delete (Satz, 1, Ort);
                end
           else begin
                  Test := Satz;
                  Satz := '';
                end;
         repeat
           Such := '}';
           Von  := pos ('(*', Test);
           if Von = 0
             then Von  := pos ('{', Test)
             else Such := '*)';
           Bis  := pos (Such, Test);
           if ((Ort > Von) and (Von > 0)) and ((Ort < Bis) or (Bis = 0))
             then Anfu_Exist := false;
           if Bis > 0
             then delete (Test, Von, Bis - Von + length (Such))
             else if Von > 0
                    then begin
                           delete (Test, Von, 255);
                           Von      := 0;
                           repeat
                             if Satz = ''
                               then begin
                                      readln (Quell_datei, Satz);
                                      File_Ende := eof (Quell_datei);
                                    end;
                             Bis  := pos (Such, Satz);
                             if Bis = 0
                               then Satz := '';
                           until Bis > 0;
                           delete (Satz,1, Bis + length (Such) - 1);
                           Bis        := 0;
                           Ort        := pos (Anfu,Satz);
                         end;
           if Anfu_exist
             then begin
                    Ort        := pos (Anfu, Satz);
                    Test       := Test + copy (Satz, 1, Ort);
                    delete (Satz, 1, Ort);
                    Ort        := pos (Anfu, Satz);
                  end;
           Anfu_Exist := (Ort > 0);
         until Von + Bis = 0;
         Verbleib := Verbleib + Test;
       until (Test = '') and (Satz = '');
       Loesche := Verbleib;
     end;    (* Loesche *)

  begin    (* Lies_Zeile *)
    repeat
      readln (Quell_Datei, Satz);
      File_Ende := eof (Quell_Datei);
      Satz      := Loesche (Satz);
      Ort       := 1;
      while Satz [Ort] = ' ' do
        Ort := succ (Ort);
      delete (Satz, 1, Ort - 1);
      Ort       := length (Satz);
      while Satz [Ort] = ' ' do
        Ort := pred (Ort);
      delete (Satz, Ort + 1, 255);
    until (length (Satz) >= 1) or File_Ende;
  end;    (* Lies_Zeile *)

  procedure Wort_finden (var Satz : Text255;var Wort_gross,Wort_norm : Text110;
                                             var Begrenzer : boolean);
  var   k                         : char;
        Zaehler                   : integer;
        Ende, Anfuehrungs_Zeichen : boolean;
        Zwischen                  : Text255;

    function Label_Gefunden : boolean;
    var Help, Help1 : LabelPtrTyp;
        A           : Text110;
        Ort         : integer;
    begin
      a    := copy (Wort_Gross, 1, pos (':', Wort_Gross) - 1);
      Help := LabelStart;
      while (Help <> nil) and (a <> Help^.Entry) do
      begin
        Help1 := Help;
        Help  := Help^.Next;
      end;
      if a = Help^.Entry
        then begin
               Ort  := succ (pos (':', Wort_Gross));
               Lab  := ' ' + copy (Wort_norm, 1, pos (':',Wort_norm) - 1)
                                                                     + ' :';
               Satz := copy (Wort_norm, Ort, length (Wort_norm)) + ' ' + Satz;
               if Help = LabelStart
                 then LabelStart  := LabelStart^.Next
                 else Help1^.Next := Help^.Next;
               dispose (Help);
               Label_Gefunden := true;
             end
        else Label_Gefunden := false;
    end;    (* Label_Gefunden *)

  begin
    repeat
      Zaehler              := 1;
      Anfuehrungs_Zeichen  := false;
      while Satz [Zaehler] = ' ' do
        Zaehler := succ (Zaehler);
      delete (Satz, 1, Zaehler - 1);
      Zaehler              := 1;
      Wort_gross           := '';
      Wort_norm            := '';
      repeat
        k         := Satz [Zaehler];
        if K = ''''
          then Anfuehrungs_Zeichen := not (Anfuehrungs_Zeichen);
        Begrenzer := not (Anfuehrungs_Zeichen) and
                    ((K = ';') or ((Wort_gross = 'END') and (K = '.')));
        Ende      := Begrenzer or (not (Anfuehrungs_Zeichen) and (K = ' '));
        if not Ende
          then begin
                 Wort_gross := Wort_gross + upcase (K);
                 Wort_norm  := Wort_norm + K;
                 Zaehler    := succ (Zaehler);
               end;
        if Zaehler >= pred (length (Satz))
          then begin
                 Lies_Zeile (Zwischen);
                 Satz       := Satz + ' ' + Zwischen;
               end;
      until Ende;
      if Wort_Gross = 'END'
        then begin
               while (Satz [Zaehler] = ' ') and (Zaehler < length (Satz)) do
                 delete (Satz, Zaehler, 1);
               if not (Satz [Zaehler] in [';', '.'])
                 then insert (' ', Satz, Zaehler);
               insert (' ', Satz, succ (Zaehler));
             end;
      delete (Satz, 1, Zaehler);
    until (Wort <> '') or OF_Fall or File_Ende or Ende;
    if pos (':', Wort_Gross) = 0
      then begin
             Zaehler := 1;
             while (Satz [Zaehler] = ' ') and (Zaehler <= length (Satz)) do
               Zaehler := succ (Zaehler);
             if (Satz [Zaehler] = ':') and (Satz [Zaehler + 1] <> '=')
               then begin
                      Wort_Gross := Wort_Gross + ':';
                      Wort_Norm  := Wort_Norm + ':';
                      delete (Satz, 1, Zaehler);
                    end;
           end;
    if pos (':', Wort_Gross) > 0
      then if Label_Gefunden
             then Wort_Finden (Satz, Wort_Gross, Wort_norm, Begrenzer);
  end;    (* Wort_finden *)

  function Wort_isolieren (var Source_Satz : Text255;
                                          Suche : Text110) : Text110;
  var  Ausdruck           : Text110;
       Begrenzer          : boolean;
       Ort, Zahl, Fehler  : integer;
  begin
    Ausdruck     := '';
    repeat
      Wort_finden (Source_Satz, Wort, Wort_norm, Begrenzer);
      if Begrenzer
        then Source_Satz := ' ; ' + Source_Satz;
      Begrenzer := (Wort = Suche);
      Ort := pos (Suche, Wort);
      val (copy (Wort, 1, Ort - 1), Zahl, Fehler);
      if (Ort > 1) and (Fehler = 0)
        then begin
               delete (Wort_Norm, Ort, length (Suche));
               Source_Satz := Suche + ' ' + Source_Satz;
             end;
      if not (Begrenzer)
        then Ausdruck := Ausdruck + ' ' + Wort_norm;
    until Begrenzer;
    Wort_isolieren := Ausdruck;
  end;    (* Wort_isolieren *)

  procedure Case_Fall (var Source_Satz : Text255); forward;

  procedure Verteile_Schluessel (Begriff : Text110;
                              var Anweisungs_Ende : boolean); forward;

  procedure Ende (var Source_Satz : Text255); forward;

  procedure Schreibe_Struktur (Zeichen : Text2; Aussage : Text110);
  var Ausgeben : boolean;
  begin
    if (Zeichen = '#P') and (Lab <> '')
      then Schreibe_Struktur ('A', '');
    Ausgeben := Aussage <> ' ';
    if Ausgeben
      then Aussage := Lab + Aussage;
    if STG_Schreiben
      then writeln (STG_Datei, Zeichen : 2, Aussage);
    if Druck_Ziel <> ohne
      then begin
             with Struktur^ do
             begin
               Symbol      :=  Zeichen;
               Bezeichnung :=  copy (Aussage, 2, 255);
               if length (Symbol) > 1
                 then Symbol_schliessen (Symbol [2])
                 else Symbol_auf (Symbol);
             end;
             Zeile := Zeile + 1;
           end
      else write ('.');
    if Ausgeben
      then Lab := '';
  end;    (* Schreibe_Struktur *)

  procedure Schleife_Beginnt (Zeichen : char);
  var Schluessel, Dummy : boolean;
      Zwischen          : Blockzeiger;
  begin
    Block^.Zeichen  := Zeichen;
    Zwischen        := Block;
    new (Block);
    Block^.Last     := Zwischen;
    repeat
      Wort_finden (Source_Zeile, Wort, Wort_norm, Dummy);
      Schluessel := (Wort = 'END');
      if not Schluessel
        then Verteile_Schluessel (Wort, Dummy);
    until Schluessel;
    Ende (Source_Zeile);
  end;   (* Schleife_Beginnt *)

  procedure Naechstes_Wort (Zeichen : char; var Source_Satz : Text255);
  var   Anweisungs_Ende : boolean;
        Zwischen        : Blockzeiger;
  begin
    Wort_Finden (Source_Satz, Wort, Wort_Norm, Anweisungs_Ende);
    if (Zeichen = 'O') and (Wort = '')
      then begin
             Wort      := '(leer)';
             Wort_Norm := Wort;
           end;
    if Wort = 'BEGIN'
      then Schleife_Beginnt (Zeichen)
      else begin
             Block^.Zeichen := Zeichen;
             Zwischen       := Block;
             new (Block);
             Block^.Last    := Zwischen;
             Verteile_Schluessel (Wort, Anweisungs_Ende);
             Block          := Block^.Last;
             Zeichen        := Block^.Zeichen;
             Wort_Finden (Source_Satz, Wort, Wort_norm, Anweisungs_Ende);
             if Anweisungs_Ende
               then Source_Satz := Wort_norm + ';' + Source_Satz
               else Source_Satz := Wort_norm + ' ' + Source_Satz;
             if (Zeichen = 'I') and  (Wort <> 'ELSE') or (Zeichen <> 'I')
               then if Zeichen = 'O'
                     then Case_Fall (Source_Satz)
                     else begin
                            if Zeichen = 'E'
                              then Zeichen := 'I';
                            if Zeichen <> 'M'
                              then Schreibe_Struktur ('#' + Zeichen, ' ');
                          end;
           end;
  end;    (* Naechstes_Wort *)

  function Begriff_Check (Begriff : Text110) : integer;
  var  i       : integer;
       Treffer : boolean;
  begin
    i       := 1;
    Treffer := false;
    while not (Treffer) and (i <> 0) do
      if Schluessel [i].Key = Begriff
        then Treffer := true
        else if Schluessel [i].Key > Begriff
               then i := Schluessel [i].Last
               else i := Schluessel [i].Next;
    Begriff_Check := i;
  end;    (* Begriff_Check *)

  procedure Label_Eintragen (var Satz : Text255);
  var Help            : LabelPtrTyp;
      Anweisungs_Ende : boolean;
  begin
    repeat
      Wort_Finden (Satz, Wort, Wort_Norm, Anweisungs_Ende);
      while (pos (',', Wort) > 0) and (Wort <> ',') do
      begin
        new (Help);
        Help^.Next  := LabelStart;
        Help^.Entry := copy (Wort, 1, pos (',', Wort) - 1);
        delete (Wort, 1, pos (',', Wort));
        LabelStart  := Help;
      end;
      if (Wort <> ',') and (Wort <> '')
        then begin
               new (Help);
               Help^.Next  := LabelStart;
               Help^.Entry := Wort;
               LabelStart  := Help;
             end;
     until Anweisungs_Ende;
   end;    (* Label_Eintragen *)

  procedure Prog_Proc_Fkt (var  Source_Satz : Text255; Overlays : boolean);
  var  Titel    : Text110;
       Dummy    : boolean;
       Zwischen : Namezeiger;
       Ort      : integer;
  begin
    if Overlays
      then Wort_Finden (Source_Satz, Wort, Titel, Dummy);
    Wort_Finden (Source_Satz, Wort, Titel, Dummy);
    Ort         := pos ('(', Titel);
    if Ort > 0
      then delete (Titel, Ort, 255)
      else begin
             Ort := pos (':', Titel);
             if Ort > 0
               then delete (Titel, Ort, 255);
           end;
    Titel_Zeiger^.Block := 'P';
    Titel_Zeiger^.Name  := ' ' + Titel;
    Zwischen    := Titel_Zeiger;
    new (Titel_Zeiger);
    Titel_Zeiger^.Last  := Zwischen;
    repeat
      Wort_Finden (Source_Satz, Wort, Wort_Norm, Dummy);
      if (Wort = 'FORWARD') or (Wort = 'EXTERNAL')
        then Titel_Zeiger := Titel_Zeiger^.Last;
      if Wort = 'LABEL'
        then Label_Eintragen (Source_Zeile);
    until (Wort = 'BEGIN') or (Wort = 'PROCEDURE') or
          (Wort = 'FUNCTION') or (Wort = 'OVERLAY');
    if Dummy
      then Source_Satz := Wort_norm + ';' + Source_Satz
      else Source_Satz := Wort_Norm + ' ' + Source_Satz;
  end;    (* Prog_Proc_Fkt *)

  procedure Unit_Implementation (var Source_Satz : Text255);
  var Titel    :  Text110;
      Dummy    : boolean;
      Zwischen : NameZeiger;
  begin
    Wort_Finden (Source_Satz, Wort, Titel, Dummy);
    Titel_Zeiger^.Block := 'P';
    Titel_Zeiger^.Name  := ' ' + Titel;
    Zwischen            := Titel_Zeiger;
    new (Titel_Zeiger);
    Titel_Zeiger^.Last  := Zwischen;
    repeat
      Wort_Finden (Source_Satz, Wort, Wort_norm, Dummy);
    until Wort = 'IMPLEMENTATION';
    repeat
      Wort_Finden (Source_Satz, Wort, Wort_norm, Dummy);
    until (Wort = 'BEGIN') or (Wort = 'PROCEDURE') or (Wort = 'FUNCTION');
    if Dummy
      then Source_Satz := Wort_norm + ';' + Source_Satz
      else Source_Satz := Wort_norm + ' ' + Source_Satz;
  end;    (* Unit_Implementation *)

  procedure Ausdruck (var Source_Satz : Text255);
  var  Schluessel, Anweisungs_Ende : boolean;
       Anweisung                   : Text110;
       Ort, i, Zahl                : integer;
  begin
    Anweisung := '';
    repeat
      Wort_Finden (Source_Satz, Wort, Wort_norm, Anweisungs_Ende);
      Schluessel := (Wort = 'END') or (Wort = 'ELSE') or (Wort = 'UNTIL');
      if not (Schluessel)
        then Anweisung := Anweisung + ' ' + Wort_Norm;
    until Schluessel or Anweisungs_Ende or File_Ende;
    if Schluessel and (Lab <> '')
      then begin
             Anweisung := Anweisung + Lab;
             Lab       := '';
           end;
    if Anweisung <> ' '
      then begin
             Ort      := pos (':=', Anweisung);
             Zahl     := 0;
             for i := 1 to Ort do
               if Anweisung [i] = ''''
                 then Zahl := succ (Zahl);
             if odd (Zahl) or (Ort = 0)
               then Schreibe_Struktur ('U', Anweisung)
               else Schreibe_Struktur ('A', Anweisung);
           end;
    if Schluessel
      then Source_Satz := Wort + ' ' + Source_Satz;
  end;    (* Ausdruck *)

  procedure Beginn;
  var  Zwischen : Blockzeiger;
       Name     : Text110;
  begin
    if Titel_Zeiger^.Last = nil
      then begin
             Name           := 'No-Name';
             Block^.Zeichen := 'P';
           end
      else begin
             Titel_Zeiger   := Titel_Zeiger^.Last;
             Name           := Titel_Zeiger^.Name;
             Block^.Zeichen := Titel_Zeiger^.Block;
           end;
    Schreibe_Struktur (Block^.Zeichen, Name);
    Zwischen     := Block;
    new (Block);
    Block^.Last  := Zwischen;
  end;   (* Beginn *)

  procedure Ende;
  var  Zeichen         : char;
       Anweisungs_Ende : boolean;
  begin
    if Block^.Last = nil
      then Zeichen := ' '
      else begin
             Block   := Block^.Last;
             Zeichen := Block^.Zeichen;
           end;
    if Zeichen <> 'M'
      then begin
             Wort_Finden (Source_Satz, Wort, Wort_norm, Anweisungs_Ende);
             if Anweisungs_Ende
               then Source_Satz := Wort_norm + ';' + Source_Satz
               else Source_Satz := Wort_norm + ' ' + Source_Satz;
             if (Zeichen = 'I') and (Wort <> 'ELSE') or (Zeichen <> 'I')
               then if Zeichen = 'O'
                      then Case_Fall (Source_Satz)
                      else if Zeichen = 'E'
                             then Schreibe_Struktur ('#I', ' ')
                             else Schreibe_Struktur ('#' + Zeichen, ' ');
           end;
  end;    (* Ende *)

  procedure If_Then_Else (var Source_Satz : Text255);
  var  Schluessel : boolean;
  begin
    Schreibe_Struktur ('I', Wort_isolieren (Source_Satz, 'THEN'));
    Schreibe_Struktur ('T', ' ');
    Naechstes_Wort ('I', Source_Satz);
    Wort_finden (Source_Satz, Wort, Wort_norm, Schluessel);
    if Wort = 'ELSE'
      then begin
             Schreibe_Struktur ('E', ' ');
             Naechstes_Wort ('E', Source_Satz);
           end
      else if Schluessel
             then Source_Satz := Wort_norm + ';' + Source_Satz
             else Source_Satz := Wort_norm + ' ' + Source_Satz;
  end;    (* If_Then_Else *)

  procedure Case_Of (var Source_Satz : Text255);
  var Verteiler  : Text110;
      Schluessel : boolean;
      Zwischen   : Blockzeiger;
  begin
    Verteiler      := '';
    repeat
      Wort_finden (Source_Satz, Wort, Wort_norm, Schluessel);
      Schluessel := (Wort = 'OF');
      if not (Schluessel)
        then Verteiler := Verteiler + ' ' + Wort_norm;
    until Schluessel;
    Schreibe_Struktur ('C', Verteiler);
    Block^.Zeichen := 'C';
    Zwischen       := Block;
    new (Block);
    Block^.Last    := Zwischen;
    Case_offen     := true;
    Case_Fall (Source_Satz);
  end;    (* Case_Of *)

  procedure Case_Fall;
  var Begriff               : Text110;
      Schluessel, Semikolon : boolean;
      Ort                   : integer;
  begin
    Begriff := '';
    repeat
      Wort_finden (Source_Satz, Wort, Wort_norm, Semikolon);
      Schluessel := (Wort = ':');
      Ort := pos (':', Wort);
      if Ort > 1
        then begin
               if Semikolon
                 then Wort_norm := Wort_norm + ';';
               Source_Satz := ': ' + copy (Wort_norm, Ort + 1, 255) + ' '
                                                              + Source_Satz;
               delete (Wort_Norm, Ort, 255);
             end;
      if not (Schluessel)
        then Begriff := Begriff + ' ' + Wort_norm;
    until Schluessel or (Wort = 'ELSE') or (Wort = 'END');
    if Wort <> 'END'
      then begin
             Schreibe_Struktur ('O', Begriff);
             OF_Fall  := true;
             Naechstes_Wort ('O', Source_Satz);
             OF_Fall  := false;
           end
      else begin
             Case_offen := false;
             Ende (Source_Satz);
           end;
  end;    (* Case_Fall *)

  procedure While_do (var Source_Satz : Text255);
  begin
    Schreibe_Struktur ('W', Wort_isolieren (Source_Satz, 'DO'));
    Naechstes_Wort ('W', Source_Satz);
  end;    (* While_do *)

  procedure For_do (var Source_Satz : Text255);
  var Variable, Beginn,
      Ende, Var1, Indikator : Text110;
      Zahl, Fehler          : integer;
      Dummy, Schluessel     : boolean;
  begin
    Wort_finden (Source_Satz, Wort, Variable, Dummy);
    Zahl := pos (':=', Variable);
    if Zahl > 0
      then begin
             delete (Variable, Zahl, 2);
             Source_Satz  := copy (Variable, Zahl, 255) + ' ' + Source_Satz;
             delete (Variable, Zahl, 255);
           end
      else begin
             Wort_finden (Source_Satz, Wort, Var1, Dummy);
             Source_Satz := copy (Var1, 3, 255) + ' ' + Source_Satz;
           end;
    Beginn   := '';
    repeat
      Wort_finden (Source_Satz, Indikator, Wort_norm, Schluessel);
      Schluessel := (Indikator = 'TO') or (Indikator = 'DOWNTO');
      if not (Schluessel)
        then Beginn := Beginn + ' ' + Wort_norm;
    until Schluessel;
    Ende     := Wort_isolieren (Source_Satz, 'DO');
    Zahl     := 1;
    while Beginn [Zahl] = ' ' do
      Zahl   := succ (Zahl);
    delete (Beginn, 1, Zahl - 1);
    val (Beginn, Zahl, Fehler);
    Var1     := Variable;
    Variable := Variable + ' := ' + Variable;
    if Indikator = 'TO'
    then  begin
            if Fehler = 0
              then begin
                     Zahl   := Zahl - 1;
                     str (Zahl, Beginn);
                   end
              else Beginn := Beginn + ' - 1';
            Variable := Variable + ' + 1';
            Ende     := ' <' + Ende;
          end
    else begin
           if Fehler = 0
             then begin
                    Zahl   := Zahl + 1;
                    str (Zahl, Beginn);
                  end
             else Beginn := Beginn + ' + 1 ';
           Variable := Variable + ' - 1';
           Ende     := ' >' + Ende;
         end;
    Ende     := Var1 + Ende;
    Schreibe_Struktur ('A', ' ' + Var1 + ' := ' + Beginn);
    Schreibe_Struktur ('W', ' ' + Ende);
    Schreibe_Struktur ('A', ' ' + Variable);
    Naechstes_Wort ('W', Source_Satz);
  end;    (* For_Do *)

  procedure Repeat_Until (var Source_Satz : Text255);
  var  Zwischen                    : Blockzeiger;
       Ausdruck                    : Text110;
       Schluessel, Anweisungs_Ende,
       Leer_Schleife               : boolean;
       Ort                         : integer;
  begin
    Schreibe_Struktur ('R', ' ');
    Block^.Zeichen  := 'R';
    Zwischen        := Block;
    new (Block);
    Block^.Last     := Zwischen;
    Leer_schleife   := true;
    repeat
      Wort_finden (Source_Satz, Wort, Wort_norm, Anweisungs_Ende);
      Schluessel := (Wort = 'UNTIL');
      Ort        := pos ('UNTIL', Wort);
      if Ort > 1
        then begin
               delete (Wort, Ort, 5);
               delete (Wort_norm, Ort, 5);
               Source_Satz := 'UNTIL ' + Source_Satz;
             end;
      if not Schluessel
        then begin
               Leer_Schleife := false;
               Verteile_Schluessel (Wort, Anweisungs_Ende);
             end;
    until Schluessel;
    if Leer_Schleife
      then Schreibe_Struktur ('A', ' (leer)');
    Ausdruck := '';
    Block    := Block^.Last;
    repeat
      Wort_finden (Source_Satz, Wort, Wort_norm, Anweisungs_Ende);
      Schluessel := (Wort = 'END') or (Wort = 'ELSE') or (Wort = 'UNTIL');
      if not Schluessel
       then Ausdruck := Ausdruck + ' ' + Wort_norm;
    until Schluessel or Anweisungs_Ende;
    Schreibe_Struktur ('#R', Ausdruck);
    if Schluessel
      then Source_Satz := Wort + ' ' + Source_Satz;
  end;    (* Repeat_Until *)

  procedure With_Do (var Source_Satz : Text255);
  var Dummy : boolean;
  begin
    repeat
      Wort_finden (Source_Satz, Wort, Wort_norm, Dummy);
    until Wort = 'DO';
    Naechstes_Wort ('M', Source_Satz);
  end;    (* With_Do *)

  procedure Go_To (var Source_Satz : Text255);
  var Dummy : boolean;
  begin
    Wort_Finden (Source_Satz, Wort, Wort_norm, Dummy);
    Wort_norm := ' GOTO ' + Wort_norm;
    Schreibe_Struktur ('A', Wort_norm);
  end;    (* Go_To *)

  procedure Verteile_Schluessel;
  var Verteiler : integer;
  begin
      Verteiler := Begriff_Check (Begriff);
      case Verteiler of
             1  : Prog_Proc_Fkt (Source_Zeile, true);
             2  : For_do (Source_Zeile);
             3  : Repeat_Until (Source_Zeile);
             4  : Case_of (Source_Zeile);
             5  : Go_to (Source_Zeile);
             7  : While_do (Source_Zeile);
             8  : Beginn;
             9  : Ende (Source_Zeile);
            11  : If_Then_else (Source_Zeile);
            13  : Unit_Implementation (Source_Zeile);
            14  : With_do (Source_Zeile);
      6, 10,12  : Prog_Proc_Fkt (Source_Zeile, false);
             0  : begin
                    if Anweisungs_Ende
                      then Source_Zeile := Wort_norm + '; ' + Source_Zeile
                      else Source_Zeile := Wort_norm + ' ' + Source_Zeile;
                  Ausdruck (Source_Zeile);
                end;
    end;
  end;    (* Verteile_Schluessel *)

  procedure Source_Init;
  var  i  : integer;
  begin
    OF_Fall        := false;
    Lab            := '';
    HProg_Gefunden := false;
    repeat
      Datei_Name (Source_Name, true, 'Quell-Datei', 19);
      assign (Quell_Datei, Source_Name);
      {$I-}  reset (Quell_Datei);   {$I+}
      Datei_Status (Source_Name);
    until Datei_ok or (length (Source_Name) < 2);
    if length (Source_Name) > 1
      then begin
             if STG_schreiben
               then begin
                      Datei_Name (Struktur_Name, false, 'Ausgabe-Datei', 19);
                      if Struktur_Name = ''
                        then begin
                               i             := pos ('.', Source_Name);
                               Struktur_Name := copy (Source_Name, 1, i - 1);
                             end;
                      assign (STG_Datei,  Struktur_Name + '.STG');
                      rewrite (STG_Datei);
                    end;
             new (Block);
             Block^.Last         := nil;
             new (Titel_Zeiger);
             Titel_Zeiger^.Last  := nil;
           end;
  end;    (* Source_Init *)

begin
  Source_Init;
  Zeile  := 1;
  if Datei_ok and (Source_Name <> '')
    then begin
           Init_Phase;
           Lies_Zeile (Source_Zeile);
           repeat
             Wort_finden (Source_Zeile, Wort, Wort_norm, Dummy1);
             Verteile_Schluessel (Wort, Dummy1);
           until (length (Source_Zeile) < 2) and File_Ende;
           if STG_Schreiben
             then begin
                    close (STG_Datei);
                    Zu_Lang := true;
                  end;
           Nachlauf;
         end;
end;    (* Source_bearbeiten *)
(*----------------------------------------------------------------------*)
(*                    Ende von STRUKTO3.PAS                             *)