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 801

Go to most recent revision | Details | Compare with Previous | View Log


------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                             P U T _ S C O S                              --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 2009-2012, Free Software Foundation, Inc.         --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license.          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------
 
with Par_SCO; use Par_SCO;
with SCOs;    use SCOs;
with Snames;  use Snames;
 
procedure Put_SCOs is
   Current_SCO_Unit : SCO_Unit_Index := 0;
   --  Initial value must not be a valid unit index
 
   procedure Write_SCO_Initiate (SU : SCO_Unit_Index);
   --  Start SCO line for unit SU, also emitting SCO unit header if necessary
 
   procedure Output_Range (T : SCO_Table_Entry);
   --  Outputs T.From and T.To in line:col-line:col format
 
   procedure Output_Source_Location (Loc : Source_Location);
   --  Output source location in line:col format
 
   procedure Output_String (S : String);
   --  Output S
 
   ------------------
   -- Output_Range --
   ------------------
 
   procedure Output_Range (T : SCO_Table_Entry) is
   begin
      Output_Source_Location (T.From);
      Write_Info_Char ('-');
      Output_Source_Location (T.To);
   end Output_Range;
 
   ----------------------------
   -- Output_Source_Location --
   ----------------------------
 
   procedure Output_Source_Location (Loc : Source_Location) is
   begin
      Write_Info_Nat  (Nat (Loc.Line));
      Write_Info_Char (':');
      Write_Info_Nat  (Nat (Loc.Col));
   end Output_Source_Location;
 
   -------------------
   -- Output_String --
   -------------------
 
   procedure Output_String (S : String) is
   begin
      for J in S'Range loop
         Write_Info_Char (S (J));
      end loop;
   end Output_String;
 
   ------------------------
   -- Write_SCO_Initiate --
   ------------------------
 
   procedure Write_SCO_Initiate (SU : SCO_Unit_Index) is
      SUT : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (SU);
 
   begin
      if Current_SCO_Unit /= SU then
         Write_Info_Initiate ('C');
         Write_Info_Char (' ');
         Write_Info_Nat (SUT.Dep_Num);
         Write_Info_Char (' ');
 
         Output_String (SUT.File_Name.all);
 
         Write_Info_Terminate;
 
         Current_SCO_Unit := SU;
      end if;
 
      Write_Info_Initiate ('C');
   end Write_SCO_Initiate;
 
--  Start of processing for Put_SCOs
 
begin
   --  Loop through entries in SCO_Unit_Table. Note that entry 0 is by
   --  convention present but unused.
 
   for U in 1 .. SCO_Unit_Table.Last loop
      declare
         SUT : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (U);
 
         Start : Nat;
         Stop  : Nat;
 
      begin
         Start := SUT.From;
         Stop  := SUT.To;
 
         --  Loop through SCO entries for this unit
 
         loop
            exit when Start = Stop + 1;
            pragma Assert (Start <= Stop);
 
            Output_SCO_Line : declare
               T            : SCO_Table_Entry renames SCO_Table.Table (Start);
               Continuation : Boolean;
 
               Ctr : Nat;
               --  Counter for statement entries
 
            begin
               case T.C1 is
 
                  --  Statements (and dominance markers)
 
                  when 'S' | '>' =>
                     Ctr := 0;
                     Continuation := False;
                     loop
                        if Ctr = 0 then
                           Write_SCO_Initiate (U);
                           if not Continuation then
                              Write_Info_Char ('S');
                              Continuation := True;
                           else
                              Write_Info_Char ('s');
                           end if;
                        end if;
 
                        Write_Info_Char (' ');
 
                        declare
                           Sent : SCO_Table_Entry
                                    renames SCO_Table.Table (Start);
                        begin
                           if Sent.C1 = '>' then
                              Write_Info_Char (Sent.C1);
                           end if;
 
                           if Sent.C2 /= ' ' then
                              Write_Info_Char (Sent.C2);
 
                              if Sent.C1 = 'S'
                                and then (Sent.C2 = 'P' or else Sent.C2 = 'p')
                                and then Sent.Pragma_Name /= Unknown_Pragma
                              then
                                 --  Strip leading "PRAGMA_"
 
                                 declare
                                    Pnam : constant String :=
                                             Sent.Pragma_Name'Img;
                                 begin
                                    Output_String
                                      (Pnam (Pnam'First + 7 .. Pnam'Last));
                                    Write_Info_Char (':');
                                 end;
                              end if;
                           end if;
 
                           --  For dependence markers (except E), output sloc.
                           --  For >E and all statement entries, output sloc
                           --  range.
 
                           if Sent.C1 = '>' and then Sent.C2 /= 'E' then
                              Output_Source_Location (Sent.From);
                           else
                              Output_Range (Sent);
                           end if;
                        end;
 
                        --  Increment entry counter (up to 6 entries per line,
                        --  continuation lines are marked Cs).
 
                        Ctr := Ctr + 1;
                        if Ctr = 6 then
                           Write_Info_Terminate;
                           Ctr := 0;
                        end if;
 
                        exit when SCO_Table.Table (Start).Last;
                        Start := Start + 1;
                     end loop;
 
                     if Ctr > 0 then
                        Write_Info_Terminate;
                     end if;
 
                  --  Decision
 
                  when 'E' | 'G' | 'I' | 'P' | 'W' | 'X' =>
                     Start := Start + 1;
 
                     --  For disabled pragma, or nested decision therein, skip
                     --  decision output.
 
                     if SCO_Pragma_Disabled (T.Pragma_Sloc) then
                        while not SCO_Table.Table (Start).Last loop
                           Start := Start + 1;
                        end loop;
 
                     --  For all other cases output decision line
 
                     else
                        Write_SCO_Initiate (U);
                        Write_Info_Char (T.C1);
 
                        if T.C1 /= 'X' then
                           Write_Info_Char (' ');
                           Output_Source_Location (T.From);
                        end if;
 
                        --  Loop through table entries for this decision
 
                        loop
                           declare
                              T : SCO_Table_Entry
                                    renames SCO_Table.Table (Start);
 
                           begin
                              Write_Info_Char (' ');
 
                              if T.C1 = '!' or else
                                 T.C1 = '&' or else
                                 T.C1 = '|'
                              then
                                 Write_Info_Char (T.C1);
                                 Output_Source_Location (T.From);
 
                              else
                                 Write_Info_Char (T.C2);
                                 Output_Range (T);
                              end if;
 
                              exit when T.Last;
                              Start := Start + 1;
                           end;
                        end loop;
 
                        Write_Info_Terminate;
                     end if;
 
                  when others =>
                     raise Program_Error;
               end case;
            end Output_SCO_Line;
 
            Start := Start + 1;
         end loop;
      end;
   end loop;
end Put_SCOs;

Browse

Tools

Subversion Repositories openrisc

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

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;`