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