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-2012, 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
26with Namet; use Namet;
27with Opt;   use Opt;
28with SCOs;  use SCOs;
29
30procedure 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
135begin
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                              Output_Source_Location (T.From);
264
265                           else
266                              Write_Info_Char (T.C2);
267                              Output_Range (T);
268                           end if;
269
270                           exit when T.Last;
271                           Start := Start + 1;
272                        end;
273                     end loop;
274
275                     Write_Info_Terminate;
276
277                  when ASCII.NUL =>
278
279                     --  Nullified entry: skip
280
281                     null;
282
283                  when others =>
284                     raise Program_Error;
285               end case;
286            end Output_SCO_Line;
287
288            Start := Start + 1;
289         end loop;
290      end;
291   end loop;
292
293   if Opt.Generate_SCO_Instance_Table then
294      Write_Instance_Table;
295   end if;
296end Put_SCOs;
297