1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2009-2012, Free Software Foundation, Inc. --
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. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with Par_SCO
; use Par_SCO
;
28 with Snames
; use Snames
;
31 Current_SCO_Unit
: SCO_Unit_Index
:= 0;
32 -- Initial value must not be a valid unit index
34 procedure Write_SCO_Initiate
(SU
: SCO_Unit_Index
);
35 -- Start SCO line for unit SU, also emitting SCO unit header if necessary
37 procedure Output_Range
(T
: SCO_Table_Entry
);
38 -- Outputs T.From and T.To in line:col-line:col format
40 procedure Output_Source_Location
(Loc
: Source_Location
);
41 -- Output source location in line:col format
43 procedure Output_String
(S
: String);
50 procedure Output_Range
(T
: SCO_Table_Entry
) is
52 Output_Source_Location
(T
.From
);
53 Write_Info_Char
('-');
54 Output_Source_Location
(T
.To
);
57 ----------------------------
58 -- Output_Source_Location --
59 ----------------------------
61 procedure Output_Source_Location
(Loc
: Source_Location
) is
63 Write_Info_Nat
(Nat
(Loc
.Line
));
64 Write_Info_Char
(':');
65 Write_Info_Nat
(Nat
(Loc
.Col
));
66 end Output_Source_Location
;
72 procedure Output_String
(S
: String) is
75 Write_Info_Char
(S
(J
));
79 ------------------------
80 -- Write_SCO_Initiate --
81 ------------------------
83 procedure Write_SCO_Initiate
(SU
: SCO_Unit_Index
) is
84 SUT
: SCO_Unit_Table_Entry
renames SCO_Unit_Table
.Table
(SU
);
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
(' ');
93 Output_String
(SUT
.File_Name
.all);
97 Current_SCO_Unit
:= SU
;
100 Write_Info_Initiate
('C');
101 end Write_SCO_Initiate
;
103 -- Start of processing for Put_SCOs
106 -- Loop through entries in SCO_Unit_Table. Note that entry 0 is by
107 -- convention present but unused.
109 for U
in 1 .. SCO_Unit_Table
.Last
loop
111 SUT
: SCO_Unit_Table_Entry
renames SCO_Unit_Table
.Table
(U
);
120 -- Loop through SCO entries for this unit
123 exit when Start
= Stop
+ 1;
124 pragma Assert
(Start
<= Stop
);
126 Output_SCO_Line
: declare
127 T
: SCO_Table_Entry
renames SCO_Table
.Table
(Start
);
128 Continuation
: Boolean;
131 -- Counter for statement entries
136 -- Statements (and dominance markers)
140 Continuation
:= False;
143 Write_SCO_Initiate
(U
);
144 if not Continuation
then
145 Write_Info_Char
('S');
146 Continuation
:= True;
148 Write_Info_Char
('s');
152 Write_Info_Char
(' ');
155 Sent
: SCO_Table_Entry
156 renames SCO_Table
.Table
(Start
);
158 if Sent
.C1
= '>' then
159 Write_Info_Char
(Sent
.C1
);
162 if Sent
.C2
/= ' ' then
163 Write_Info_Char
(Sent
.C2
);
166 and then (Sent
.C2
= 'P' or else Sent
.C2
= 'p')
167 and then Sent
.Pragma_Name
/= Unknown_Pragma
169 -- Strip leading "PRAGMA_"
172 Pnam
: constant String :=
173 Sent
.Pragma_Name
'Img;
176 (Pnam
(Pnam
'First + 7 .. Pnam
'Last));
177 Write_Info_Char
(':');
182 -- For dependence markers (except E), output sloc.
183 -- For >E and all statement entries, output sloc
186 if Sent
.C1
= '>' and then Sent
.C2
/= 'E' then
187 Output_Source_Location
(Sent
.From
);
193 -- Increment entry counter (up to 6 entries per line,
194 -- continuation lines are marked Cs).
198 Write_Info_Terminate
;
202 exit when SCO_Table
.Table
(Start
).Last
;
207 Write_Info_Terminate
;
212 when 'E' |
'G' |
'I' |
'P' |
'W' |
'X' =>
215 -- For disabled pragma, or nested decision therein, skip
218 if SCO_Pragma_Disabled
(T
.Pragma_Sloc
) then
219 while not SCO_Table
.Table
(Start
).Last
loop
223 -- For all other cases output decision line
226 Write_SCO_Initiate
(U
);
227 Write_Info_Char
(T
.C1
);
230 Write_Info_Char
(' ');
231 Output_Source_Location
(T
.From
);
234 -- Loop through table entries for this decision
239 renames SCO_Table
.Table
(Start
);
242 Write_Info_Char
(' ');
244 if T
.C1
= '!' or else
248 Write_Info_Char
(T
.C1
);
249 Output_Source_Location
(T
.From
);
252 Write_Info_Char
(T
.C2
);
261 Write_Info_Terminate
;