gcc/ada/put_scos.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             P U T _ S C O S                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2009-2017, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 with Namet;
  27 with Opt;
  28 with SCOs; use SCOs;
  29
  30 procedure Put_SCOs is
  31    Current_SCO_Unit : SCO_Unit_Index := 0;
  32    --  Initial value must not be a valid unit index
  33
  34    procedure Write_SCO_Initiate (SU : SCO_Unit_Index);
  35    --  Start SCO line for unit SU, also emitting SCO unit header if necessary
  36
  37    procedure Write_Instance_Table;
  38    --  Output the SCO table of instances
  39
  40    procedure Output_Range (T : SCO_Table_Entry);
  41    --  Outputs T.From and T.To in line:col-line:col format
  42
  43    procedure Output_Source_Location (Loc : Source_Location);
  44    --  Output source location in line:col format
  45
  46    procedure Output_String (S : String);
  47    --  Output S
  48
  49    ------------------
  50    -- Output_Range --
  51    ------------------
  52
  53    procedure Output_Range (T : SCO_Table_Entry) is
  54    begin
  55       Output_Source_Location (T.From);
  56       Write_Info_Char ('-');
  57       Output_Source_Location (T.To);
  58    end Output_Range;
  59
  60    ----------------------------
  61    -- Output_Source_Location --
  62    ----------------------------
  63
  64    procedure Output_Source_Location (Loc : Source_Location) is
  65    begin
  66       Write_Info_Nat  (Nat (Loc.Line));
  67       Write_Info_Char (':');
  68       Write_Info_Nat  (Nat (Loc.Col));
  69    end Output_Source_Location;
  70
  71    -------------------
  72    -- Output_String --
  73    -------------------
  74
  75    procedure Output_String (S : String) is
  76    begin
  77       for J in S'Range loop
  78          Write_Info_Char (S (J));
  79       end loop;
  80    end Output_String;
  81
  82    --------------------------
  83    -- Write_Instance_Table --
  84    --------------------------
  85
  86    procedure Write_Instance_Table is
  87    begin
  88       for J in 1 .. SCO_Instance_Table.Last loop
  89          declare
  90             SIE : SCO_Instance_Table_Entry
  91                     renames SCO_Instance_Table.Table (J);
  92          begin
  93             Output_String ("C i ");
  94             Write_Info_Nat (Nat (J));
  95             Write_Info_Char (' ');
  96             Write_Info_Nat (SIE.Inst_Dep_Num);
  97             Write_Info_Char ('|');
  98             Output_Source_Location (SIE.Inst_Loc);
  99
 100             if SIE.Enclosing_Instance > 0 then
 101                Write_Info_Char (' ');
 102                Write_Info_Nat (Nat (SIE.Enclosing_Instance));
 103             end if;
 104             Write_Info_Terminate;
 105          end;
 106       end loop;
 107    end Write_Instance_Table;
 108
 109    ------------------------
 110    -- Write_SCO_Initiate --
 111    ------------------------
 112
 113    procedure Write_SCO_Initiate (SU : SCO_Unit_Index) is
 114       SUT : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (SU);
 115
 116    begin
 117       if Current_SCO_Unit /= SU then
 118          Write_Info_Initiate ('C');
 119          Write_Info_Char (' ');
 120          Write_Info_Nat (SUT.Dep_Num);
 121          Write_Info_Char (' ');
 122
 123          Output_String (SUT.File_Name.all);
 124
 125          Write_Info_Terminate;
 126
 127          Current_SCO_Unit := SU;
 128       end if;
 129
 130       Write_Info_Initiate ('C');
 131    end Write_SCO_Initiate;
 132
 133 --  Start of processing for Put_SCOs
 134
 135 begin
 136    --  Loop through entries in SCO_Unit_Table. Note that entry 0 is by
 137    --  convention present but unused.
 138
 139    for U in 1 .. SCO_Unit_Table.Last loop
 140       declare
 141          SUT : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (U);
 142
 143          Start : Nat;
 144          Stop  : Nat;
 145
 146       begin
 147          Start := SUT.From;
 148          Stop  := SUT.To;
 149
 150          --  Loop through SCO entries for this unit
 151
 152          loop
 153             exit when Start = Stop + 1;
 154             pragma Assert (Start <= Stop);
 155
 156             Output_SCO_Line : declare
 157                T            : SCO_Table_Entry renames SCO_Table.Table (Start);
 158                Continuation : Boolean;
 159
 160                Ctr : Nat;
 161                --  Counter for statement entries
 162
 163             begin
 164                case T.C1 is
 165
 166                   --  Statements (and dominance markers)
 167
 168                   when 'S' | '>' =>
 169                      Ctr := 0;
 170                      Continuation := False;
 171                      loop
 172                         if Ctr = 0 then
 173                            Write_SCO_Initiate (U);
 174                            if not Continuation then
 175                               Write_Info_Char ('S');
 176                               Continuation := True;
 177                            else
 178                               Write_Info_Char ('s');
 179                            end if;
 180                         end if;
 181
 182                         Write_Info_Char (' ');
 183
 184                         declare
 185                            Sent : SCO_Table_Entry
 186                                     renames SCO_Table.Table (Start);
 187                         begin
 188                            if Sent.C1 = '>' then
 189                               Write_Info_Char (Sent.C1);
 190                            end if;
 191
 192                            if Sent.C2 /= ' ' then
 193                               Write_Info_Char (Sent.C2);
 194
 195                               if Sent.C1 = 'S'
 196                                 and then (Sent.C2 = 'P' or else Sent.C2 = 'p')
 197                                 and then Sent.Pragma_Aspect_Name /= No_Name
 198                               then
 199                                  Write_Info_Name (Sent.Pragma_Aspect_Name);
 200                                  Write_Info_Char (':');
 201                               end if;
 202                            end if;
 203
 204                            --  For dependence markers (except E), output sloc.
 205                            --  For >E and all statement entries, output sloc
 206                            --  range.
 207
 208                            if Sent.C1 = '>' and then Sent.C2 /= 'E' then
 209                               Output_Source_Location (Sent.From);
 210                            else
 211                               Output_Range (Sent);
 212                            end if;
 213                         end;
 214
 215                         --  Increment entry counter (up to 6 entries per line,
 216                         --  continuation lines are marked Cs).
 217
 218                         Ctr := Ctr + 1;
 219                         if Ctr = 6 then
 220                            Write_Info_Terminate;
 221                            Ctr := 0;
 222                         end if;
 223
 224                         exit when SCO_Table.Table (Start).Last;
 225                         Start := Start + 1;
 226                      end loop;
 227
 228                      if Ctr > 0 then
 229                         Write_Info_Terminate;
 230                      end if;
 231
 232                   --  Decision
 233
 234                   when 'E' | 'G' | 'I' | 'P' | 'W' | 'X' | 'A' =>
 235                      Start := Start + 1;
 236
 237                      Write_SCO_Initiate (U);
 238                      Write_Info_Char (T.C1);
 239
 240                      if T.C1 = 'A' then
 241                         Write_Info_Name (T.Pragma_Aspect_Name);
 242                      end if;
 243
 244                      if T.C1 /= 'X' then
 245                         Write_Info_Char (' ');
 246                         Output_Source_Location (T.From);
 247                      end if;
 248
 249                      --  Loop through table entries for this decision
 250
 251                      loop
 252                         declare
 253                            T : SCO_Table_Entry renames SCO_Table.Table (Start);
 254
 255                         begin
 256                            Write_Info_Char (' ');
 257
 258                            if T.C1 = '!' or else
 259                               T.C1 = '&' or else
 260                               T.C1 = '|'
 261                            then
 262                               Write_Info_Char (T.C1);
 263                               pragma Assert (T.C2 /= '?');
 264                               Output_Source_Location (T.From);
 265
 266                            else
 267                               Write_Info_Char (T.C2);
 268                               Output_Range (T);
 269                            end if;
 270
 271                            exit when T.Last;
 272                            Start := Start + 1;
 273                         end;
 274                      end loop;
 275
 276                      Write_Info_Terminate;
 277
 278                   when ASCII.NUL =>
 279
 280                      --  Nullified entry: skip
 281
 282                      null;
 283
 284                   when others =>
 285                      raise Program_Error;
 286                end case;
 287             end Output_SCO_Line;
 288
 289             Start := Start + 1;
 290          end loop;
 291       end;
 292    end loop;
 293
 294    if Opt.Generate_SCO_Instance_Table then
 295       Write_Instance_Table;
 296    end if;
 297 end Put_SCOs;