home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 05 / pascal / strukto4.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1989-01-02  |  10.4 KB  |  255 lines
  1. (*----------------------------------------------------------------------*)
  2. (*                       STRUKTO4.PAS                                   *)
  3. (*              Generierung von Programmorganisationsplaenen            *)
  4. (* {$A-}  rekursiven Code erzeugen unter CP/M-80 *)
  5.  
  6. procedure POP_Erstellen;
  7. var  Aktdef, Zwischen         : POPDef_Ptr;
  8.      Aktruf                   : POP_Ptr;
  9.      Basis_Seg, Basis_Ofs,
  10.      Ende_Seg, Ende_Ofs       : integer;     (*MS-DOS*)
  11.    (* Def_Ende, Basis_POP       : integer);   CP/M *)
  12.      Ebene                    : integer;
  13.      POP_Zeile, Strich_Zeile  : Text110;
  14.  
  15. procedure Lese_Def (var Ende_Seg, Ende_Ofs : integer);   (*MS-DOS*)
  16.                 (* (var Def_Ende : integer);     CP/M *)
  17. var Zwischen : POPDef_Ptr;
  18.     i        : integer;
  19. begin
  20.   repeat
  21.     if Struktur^.Symbol [1] = 'P'
  22.       then begin
  23.              Zwischen        := Aktdef;
  24.              new (Aktdef);
  25.              Zwischen^.Next  := Aktdef;
  26.              Aktdef^.Name    := copy (Struktur^.Bezeichnung, 1,
  27.                                     length (Struktur^.Bezeichnung) - 1);
  28.              for i := 1 to length (Aktdef^.Name) do
  29.                Aktdef^.Name [i] := upcase (Aktdef^.Name [i]);
  30.              Aktdef^.Waage   := nil;
  31.              Aktdef^.Gezeigt := false;
  32.              Aktdef^.Gleich  := Zwischen;
  33.              Aktdef^.Next    := nil;
  34.            end;
  35.     Zeile    := succ (Zeile);
  36.     Struktur := Struktur^.Next;
  37.     if (Zeile >= Zeile_Akt)
  38.       then begin
  39.              Lesen (Zeile_Akt, false);
  40.              Struktur   := Anfangs_Pointer;
  41.            end;
  42.   until (Struktur = nil);
  43.   Ende_Seg   := seg (Aktdef^);   (*MS-DOS*)
  44.   Ende_Ofs   := ofs (Aktdef^);
  45. (* Def_Ende    := ord (Aktdef);    CP/M *)
  46. end;    (* Lese_Def *)
  47.  
  48. procedure Verweise_Erstellen (Basis_seg, Basis_Ofs : integer);  (*MS-DOS*)
  49.                           (* (Basis_POP : integer)  CP/M *)
  50. var Zwischen1       : POP_Ptr;
  51.     Zwischen        : POPDef_Ptr;
  52.     Hilf            : Text110;
  53.     i, Ort, Ort1    : integer;
  54.     Fehl            : set of char;
  55.     Erster, Treffer : boolean;
  56. begin
  57.    Fehl   := ['A'..'Z', 'a'..'z', '0'..'9', '_', '^', '.'];
  58.    repeat
  59.      if (Struktur^.Symbol [1] in ['W', 'A', 'U', 'I', 'C'])
  60.          or (Struktur^.Symbol = '#R')
  61.        then begin
  62.               Zwischen := ptr (Basis_Seg, Basis_Ofs);       (*MS-DOS*)
  63.            (*   Zwischen := ptr (Basis_POP);    CP/M *)
  64.               Zwischen := Zwischen^.Next;
  65.               Hilf     := Struktur^.Bezeichnung;
  66.               for i := 1 to length (Hilf) do
  67.                 Hilf [i] := upcase (Hilf [i]);
  68.               Ort      := pos ('''', Hilf);
  69.               while Ort > 0 do
  70.               begin
  71.                 Hilf [Ort]  := ' ';
  72.                 Ort1        := pos ('''', Hilf);
  73.                 if Ort1 > 0
  74.                   then delete (Hilf, Ort, Ort1 - Ort + 1);
  75.                 Ort         := pos ('''', Hilf);
  76.               end;
  77.               Ort1     := pos (':=', Hilf);
  78.               while Zwischen <> nil do
  79.               begin
  80.                 Treffer := false;
  81.                 while (Zwischen <> nil) and not (Treffer) do
  82.                 begin
  83.                   Ort     := pos (Zwischen^.Name, Hilf);
  84.                   Treffer := (Ort > 0) and not
  85.                               (Hilf [Ort + length (Zwischen^.Name)] in Fehl);
  86.                   if Ort > 1
  87.                     then Treffer := Treffer and not (Hilf [Ort - 1] in Fehl);
  88.                   if Treffer
  89.                     then begin
  90.                            if Ort1 > Ort
  91.                              then begin
  92.                                     delete (Hilf, 1, Ort1 - 1);
  93.                                     Ort1    := 1;
  94.                                     Treffer := false;
  95.                                   end;
  96.                          end
  97.                     else Zwischen := Zwischen^.Next;
  98.                 end;
  99.                 if Treffer
  100.                   then begin
  101.                          Zwischen1 := Aktdef^.Waage;
  102.                          Treffer   := false;
  103.                          while (Zwischen1 <> nil) and not (Treffer) do
  104.                          begin
  105.                            Treffer   := (Zwischen = Zwischen1^.Adr);
  106.                            Zwischen1 := Zwischen1^.Gleich;
  107.                          end;
  108.                          if not Treffer
  109.                            then begin
  110.                                   Zwischen1      := Aktruf;
  111.                                   new (Aktruf);
  112.                                   Aktruf^.Adr    := Zwischen;
  113.                                   Aktruf^.Gleich := nil;
  114.                                   if Erster
  115.                                     then Aktdef^.Waage     := Aktruf
  116.                                     else Zwischen1^.Gleich := Aktruf;
  117.                                   Erster         := false;
  118.                                 end;
  119.                          Zwischen  := Zwischen^.Next;
  120.                        end;
  121.               end;
  122.             end
  123.        else if Struktur^.Symbol [1] = 'P'
  124.               then begin
  125.                      Aktdef := Aktdef^.Next;
  126.                      Erster := true;
  127.                    end;
  128.        Zeile    := succ (Zeile);
  129.        Struktur := Struktur^.Next;
  130.        if (Zeile >= Zeile_Akt)
  131.          then begin
  132.                 Lesen (Zeile_Akt, false);
  133.                 Struktur := Anfangs_Pointer;
  134.               end;
  135.   until (Struktur = nil);
  136. end;    (* Verweise_Erstellen *)
  137.  
  138. procedure Schreibe_POP (Start : POP_Ptr);
  139. var Faktor, i, Ort : integer;
  140.     pAdr           : POPDef_Ptr;
  141.     Gesehen        : boolean;
  142. begin
  143.   pAdr          := Start^.Adr;
  144.   Faktor        := 1 + Ebene * Feldlaenge;
  145.   Ort           := length (pAdr^.Name);
  146.   POP_Zeile     := POP_Zeile + Waagerecht + pAdr^.Name;  (* Name eintragen *)
  147.   POP_Zeile [1] := ' ';
  148.   Gesehen       := pAdr^.Gezeigt;
  149.   pAdr^.Gezeigt := true;
  150.   if (pAdr^.Waage <> nil) and not (Gesehen)
  151.     then begin                       (* 1. Aufruf => Schachtelung erhöhen *)
  152.            if (pAdr^.Waage^.Adr <> nil)
  153.              then begin
  154.                     while Ort < Feldlaenge - 2 do
  155.                     begin
  156.                       POP_Zeile := POP_Zeile + Waagerecht;
  157.                       Ort       := succ (Ort);
  158.                     end;
  159.                     if Ort <= Feldlaenge - 2
  160.                       then POP_Zeile   := POP_Zeile + Obenrechts;
  161.                   end;
  162.            writeln (Destination, ' ' : Links, Strich_Zeile);
  163.            writeln (Destination, ' ' : Links, POP_Zeile);
  164.            Strich_Zeile  := Strich_Zeile + copy (Blank, 1, Feldlaenge - 1)
  165.                                                                 + Senkrecht;
  166.            if (Faktor > 1) and (Start^.Gleich = nil)
  167.              then Strich_Zeile [Faktor - 1]  := ' ';
  168.            POP_Zeile     := Strich_Zeile;
  169.            if padr^.Waage^.Gleich <> nil
  170.              then POP_Zeile [Faktor - 1 + Feldlaenge] := KreuzLinks
  171.              else POP_Zeile [Faktor - 1 + Feldlaenge] := Untenlinks;
  172.            Ebene         := succ (Ebene);
  173.            Schreibe_POP (pAdr^.Waage);
  174.          end
  175.     else begin                  (* kein 1.Aufruf => Schachtelung bleibt*)
  176.            writeln (Destination, ' ' : Links, Strich_Zeile);
  177.            writeln (Destination, ' ' : Links, POP_Zeile);
  178.            POP_Zeile     := Strich_Zeile;
  179.          end;
  180.     if Start^.Gleich <> nil
  181.       then begin                  (* 2.-n. Aufruf => Schachtelung bleibt *)
  182.              if Start^.Gleich^.Gleich <> nil
  183.                then POP_Zeile [Faktor - 1] := Kreuzlinks
  184.                else POP_Zeile [Faktor - 1] := Untenlinks;
  185.              Schreibe_POP (Start^.Gleich);
  186.            end
  187.       else begin          (* kein 2.-n. Aufruf => Schachtelung reduzieren *)
  188.              Ebene       := pred (Ebene);
  189.              Faktor      := 1 + Ebene * Feldlaenge;
  190.              if Faktor < 1
  191.                then Faktor := 1;
  192.              delete (Strich_Zeile, Faktor, 255);
  193.              POP_Zeile   := Strich_Zeile;
  194.            end;
  195. end;    (* Schreibe_POP *)
  196.  
  197. begin
  198.   Zeile := 1;
  199.   if Zu_Lang
  200.     then begin
  201.            {$I-} reset (STG_Datei);  {$I+}
  202.            Datei_Status (Struktur_Name);
  203.            if Datei_Ok
  204.              then Lesen (Zeile_Akt, true);
  205.          end
  206.     else if Anfangs_Pointer = Ende_Pointer
  207.            then Datei_Lesen
  208.            else begin
  209.                   {$I-} reset (STG_Datei);  {$I+}
  210.                   Datei_Status (Struktur_Name);
  211.                 end;
  212.   if Datei_Ok and (Struktur_Name <> '')
  213.     then begin
  214.            Init_Phase;
  215.            mark (Aktdef);
  216.            Basis_Seg          := seg (Aktdef^);   (*MS-DOS*)
  217.            Basis_Ofs          := ofs (Aktdef^);
  218.         (*  Basis_POP           := ord (Aktdef);    CP/M *)
  219.            new (Aktdef);
  220.            Struktur           := Anfangs_Pointer;
  221.            Lese_Def (Ende_Seg, Ende_Ofs);           (* MS-DOS *)
  222.          (*  Lese_Def (Def_Ende);                       CP/M *)
  223.            Aktdef             := ptr (Basis_Seg, Basis_Ofs);  (*MS-DOS*)
  224.          (*  Aktdef             := ptr (Basis_POP);     CP/M *)
  225.            Ende_Pointer^.Next := Hilfs_Ptr;
  226.            close (STG_Datei);
  227.            {$I-} reset (STG_Datei);  {$I+}
  228.            Datei_Status (Struktur_Name);
  229.            Zeile              := 1;
  230.            if Datei_Ok and Zu_Lang
  231.              then Lesen (Zeile_Akt, false);
  232.            Struktur           := Anfangs_Pointer;
  233.            Verweise_Erstellen (Basis_Seg, Basis_Ofs);        (*MS-DOS*)
  234.         (*   Verweise_Erstellen (Basis_POP);                     CP/M *)
  235.            Zwischen           := ptr (Ende_Seg, Ende_Ofs);   (*MS-DOS*)
  236.         (*   Zwischen           := ptr (Def_Ende);                 CP/M *)
  237.            new (Aktruf);
  238.            Aktruf^.Adr        := Zwischen;
  239.            Aktruf^.Gleich     := nil;
  240.            POP_Zeile          := '';
  241.            Strich_Zeile       := '';
  242.            Ebene              := 0;
  243.            Schreibe_POP (Aktruf);
  244.            writeln (Destination, ' ');
  245.            writeln (Destination, ' ');
  246.            writeln (Destination, ' ');
  247.            Aktdef             := ptr (Basis_Seg, Basis_Ofs);   (*MS-DOS*)
  248.          (*  Aktdef             := ptr (Basis_POP);                CP/M*)
  249.            release (Aktdef);
  250.            Nachlauf;
  251.         end;
  252.  end;    (* POP_Erstellen *)
  253. (*----------------------------------------------------------------------*)
  254. (*                    Ende von STRUKTO4.PAS                             *)
  255.