OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [put_scos.adb] - Blame information for rev 706

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 706 jeremybenn
------------------------------------------------------------------------------
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
 
26
with Par_SCO; use Par_SCO;
27
with SCOs;    use SCOs;
28
with Snames;  use Snames;
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 Output_Range (T : SCO_Table_Entry);
38
   --  Outputs T.From and T.To in line:col-line:col format
39
 
40
   procedure Output_Source_Location (Loc : Source_Location);
41
   --  Output source location in line:col format
42
 
43
   procedure Output_String (S : String);
44
   --  Output S
45
 
46
   ------------------
47
   -- Output_Range --
48
   ------------------
49
 
50
   procedure Output_Range (T : SCO_Table_Entry) is
51
   begin
52
      Output_Source_Location (T.From);
53
      Write_Info_Char ('-');
54
      Output_Source_Location (T.To);
55
   end Output_Range;
56
 
57
   ----------------------------
58
   -- Output_Source_Location --
59
   ----------------------------
60
 
61
   procedure Output_Source_Location (Loc : Source_Location) is
62
   begin
63
      Write_Info_Nat  (Nat (Loc.Line));
64
      Write_Info_Char (':');
65
      Write_Info_Nat  (Nat (Loc.Col));
66
   end Output_Source_Location;
67
 
68
   -------------------
69
   -- Output_String --
70
   -------------------
71
 
72
   procedure Output_String (S : String) is
73
   begin
74
      for J in S'Range loop
75
         Write_Info_Char (S (J));
76
      end loop;
77
   end Output_String;
78
 
79
   ------------------------
80
   -- Write_SCO_Initiate --
81
   ------------------------
82
 
83
   procedure Write_SCO_Initiate (SU : SCO_Unit_Index) is
84
      SUT : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (SU);
85
 
86
   begin
87
      if Current_SCO_Unit /= SU then
88
         Write_Info_Initiate ('C');
89
         Write_Info_Char (' ');
90
         Write_Info_Nat (SUT.Dep_Num);
91
         Write_Info_Char (' ');
92
 
93
         Output_String (SUT.File_Name.all);
94
 
95
         Write_Info_Terminate;
96
 
97
         Current_SCO_Unit := SU;
98
      end if;
99
 
100
      Write_Info_Initiate ('C');
101
   end Write_SCO_Initiate;
102
 
103
--  Start of processing for Put_SCOs
104
 
105
begin
106
   --  Loop through entries in SCO_Unit_Table. Note that entry 0 is by
107
   --  convention present but unused.
108
 
109
   for U in 1 .. SCO_Unit_Table.Last loop
110
      declare
111
         SUT : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (U);
112
 
113
         Start : Nat;
114
         Stop  : Nat;
115
 
116
      begin
117
         Start := SUT.From;
118
         Stop  := SUT.To;
119
 
120
         --  Loop through SCO entries for this unit
121
 
122
         loop
123
            exit when Start = Stop + 1;
124
            pragma Assert (Start <= Stop);
125
 
126
            Output_SCO_Line : declare
127
               T            : SCO_Table_Entry renames SCO_Table.Table (Start);
128
               Continuation : Boolean;
129
 
130
               Ctr : Nat;
131
               --  Counter for statement entries
132
 
133
            begin
134
               case T.C1 is
135
 
136
                  --  Statements (and dominance markers)
137
 
138
                  when 'S' | '>' =>
139
                     Ctr := 0;
140
                     Continuation := False;
141
                     loop
142
                        if Ctr = 0 then
143
                           Write_SCO_Initiate (U);
144
                           if not Continuation then
145
                              Write_Info_Char ('S');
146
                              Continuation := True;
147
                           else
148
                              Write_Info_Char ('s');
149
                           end if;
150
                        end if;
151
 
152
                        Write_Info_Char (' ');
153
 
154
                        declare
155
                           Sent : SCO_Table_Entry
156
                                    renames SCO_Table.Table (Start);
157
                        begin
158
                           if Sent.C1 = '>' then
159
                              Write_Info_Char (Sent.C1);
160
                           end if;
161
 
162
                           if Sent.C2 /= ' ' then
163
                              Write_Info_Char (Sent.C2);
164
 
165
                              if Sent.C1 = 'S'
166
                                and then (Sent.C2 = 'P' or else Sent.C2 = 'p')
167
                                and then Sent.Pragma_Name /= Unknown_Pragma
168
                              then
169
                                 --  Strip leading "PRAGMA_"
170
 
171
                                 declare
172
                                    Pnam : constant String :=
173
                                             Sent.Pragma_Name'Img;
174
                                 begin
175
                                    Output_String
176
                                      (Pnam (Pnam'First + 7 .. Pnam'Last));
177
                                    Write_Info_Char (':');
178
                                 end;
179
                              end if;
180
                           end if;
181
 
182
                           --  For dependence markers (except E), output sloc.
183
                           --  For >E and all statement entries, output sloc
184
                           --  range.
185
 
186
                           if Sent.C1 = '>' and then Sent.C2 /= 'E' then
187
                              Output_Source_Location (Sent.From);
188
                           else
189
                              Output_Range (Sent);
190
                           end if;
191
                        end;
192
 
193
                        --  Increment entry counter (up to 6 entries per line,
194
                        --  continuation lines are marked Cs).
195
 
196
                        Ctr := Ctr + 1;
197
                        if Ctr = 6 then
198
                           Write_Info_Terminate;
199
                           Ctr := 0;
200
                        end if;
201
 
202
                        exit when SCO_Table.Table (Start).Last;
203
                        Start := Start + 1;
204
                     end loop;
205
 
206
                     if Ctr > 0 then
207
                        Write_Info_Terminate;
208
                     end if;
209
 
210
                  --  Decision
211
 
212
                  when 'E' | 'G' | 'I' | 'P' | 'W' | 'X' =>
213
                     Start := Start + 1;
214
 
215
                     --  For disabled pragma, or nested decision therein, skip
216
                     --  decision output.
217
 
218
                     if SCO_Pragma_Disabled (T.Pragma_Sloc) then
219
                        while not SCO_Table.Table (Start).Last loop
220
                           Start := Start + 1;
221
                        end loop;
222
 
223
                     --  For all other cases output decision line
224
 
225
                     else
226
                        Write_SCO_Initiate (U);
227
                        Write_Info_Char (T.C1);
228
 
229
                        if T.C1 /= 'X' then
230
                           Write_Info_Char (' ');
231
                           Output_Source_Location (T.From);
232
                        end if;
233
 
234
                        --  Loop through table entries for this decision
235
 
236
                        loop
237
                           declare
238
                              T : SCO_Table_Entry
239
                                    renames SCO_Table.Table (Start);
240
 
241
                           begin
242
                              Write_Info_Char (' ');
243
 
244
                              if T.C1 = '!' or else
245
                                 T.C1 = '&' or else
246
                                 T.C1 = '|'
247
                              then
248
                                 Write_Info_Char (T.C1);
249
                                 Output_Source_Location (T.From);
250
 
251
                              else
252
                                 Write_Info_Char (T.C2);
253
                                 Output_Range (T);
254
                              end if;
255
 
256
                              exit when T.Last;
257
                              Start := Start + 1;
258
                           end;
259
                        end loop;
260
 
261
                        Write_Info_Terminate;
262
                     end if;
263
 
264
                  when others =>
265
                     raise Program_Error;
266
               end case;
267
            end Output_SCO_Line;
268
 
269
            Start := Start + 1;
270
         end loop;
271
      end;
272
   end loop;
273
end Put_SCOs;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.