1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- S Y M B O L S . P R O C E S S I N G -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2004-2009, 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-- This is the VMS/IA64 version of this package 27 28with Ada.IO_Exceptions; 29 30with Ada.Unchecked_Deallocation; 31 32separate (Symbols) 33package body Processing is 34 35 type String_Array is array (Positive range <>) of String_Access; 36 type Strings_Ptr is access String_Array; 37 38 procedure Free is 39 new Ada.Unchecked_Deallocation (String_Array, Strings_Ptr); 40 41 type Section_Header is record 42 Shname : Integer; 43 Shtype : Integer; 44 Shoffset : Integer; 45 Shsize : Integer; 46 Shlink : Integer; 47 end record; 48 49 type Section_Header_Array is array (Natural range <>) of Section_Header; 50 type Section_Header_Ptr is access Section_Header_Array; 51 52 procedure Free is 53 new Ada.Unchecked_Deallocation (Section_Header_Array, Section_Header_Ptr); 54 55 ------------- 56 -- Process -- 57 ------------- 58 59 procedure Process 60 (Object_File : String; 61 Success : out Boolean) 62 is 63 B : Byte; 64 W : Integer; 65 66 Str : String (1 .. 1000) := (others => ' '); 67 Str_Last : Natural; 68 69 Strings : Strings_Ptr; 70 71 Shoff : Integer; 72 Shnum : Integer; 73 Shentsize : Integer; 74 75 Shname : Integer; 76 Shtype : Integer; 77 Shoffset : Integer; 78 Shsize : Integer; 79 Shlink : Integer; 80 81 Symtab_Index : Natural := 0; 82 String_Table_Index : Natural := 0; 83 84 End_Symtab : Integer; 85 86 Stname : Integer; 87 Stinfo : Character; 88 Stother : Character; 89 Sttype : Integer; 90 Stbind : Integer; 91 Stshndx : Integer; 92 Stvis : Integer; 93 94 STV_Internal : constant := 1; 95 STV_Hidden : constant := 2; 96 97 Section_Headers : Section_Header_Ptr; 98 99 Offset : Natural := 0; 100 OK : Boolean := True; 101 102 procedure Get_Byte (B : out Byte); 103 -- Read one byte from the object file 104 105 procedure Get_Half (H : out Integer); 106 -- Read one half work from the object file 107 108 procedure Get_Word (W : out Integer); 109 -- Read one full word from the object file 110 111 procedure Reset; 112 -- Restart reading the object file 113 114 procedure Skip_Half; 115 -- Read and disregard one half word from the object file 116 117 -------------- 118 -- Get_Byte -- 119 -------------- 120 121 procedure Get_Byte (B : out Byte) is 122 begin 123 Byte_IO.Read (File, B); 124 Offset := Offset + 1; 125 end Get_Byte; 126 127 -------------- 128 -- Get_Half -- 129 -------------- 130 131 procedure Get_Half (H : out Integer) is 132 C1, C2 : Character; 133 begin 134 Get_Byte (C1); Get_Byte (C2); 135 H := 136 Integer'(Character'Pos (C2)) * 256 + Integer'(Character'Pos (C1)); 137 end Get_Half; 138 139 -------------- 140 -- Get_Word -- 141 -------------- 142 143 procedure Get_Word (W : out Integer) is 144 H1, H2 : Integer; 145 begin 146 Get_Half (H1); Get_Half (H2); 147 W := H2 * 256 * 256 + H1; 148 end Get_Word; 149 150 ----------- 151 -- Reset -- 152 ----------- 153 154 procedure Reset is 155 begin 156 Offset := 0; 157 Byte_IO.Reset (File); 158 end Reset; 159 160 --------------- 161 -- Skip_Half -- 162 --------------- 163 164 procedure Skip_Half is 165 B : Byte; 166 pragma Unreferenced (B); 167 begin 168 Byte_IO.Read (File, B); 169 Byte_IO.Read (File, B); 170 Offset := Offset + 2; 171 end Skip_Half; 172 173 -- Start of processing for Process 174 175 begin 176 -- Open the object file with Byte_IO. Return with Success = False if 177 -- this fails. 178 179 begin 180 Open (File, In_File, Object_File); 181 exception 182 when others => 183 Put_Line 184 ("*** Unable to open object file """ & Object_File & """"); 185 Success := False; 186 return; 187 end; 188 189 -- Assume that the object file has a correct format 190 191 Success := True; 192 193 -- Skip ELF identification 194 195 while Offset < 16 loop 196 Get_Byte (B); 197 end loop; 198 199 -- Skip e_type 200 201 Skip_Half; 202 203 -- Skip e_machine 204 205 Skip_Half; 206 207 -- Skip e_version 208 209 Get_Word (W); 210 211 -- Skip e_entry 212 213 for J in 1 .. 8 loop 214 Get_Byte (B); 215 end loop; 216 217 -- Skip e_phoff 218 219 for J in 1 .. 8 loop 220 Get_Byte (B); 221 end loop; 222 223 Get_Word (Shoff); 224 225 -- Skip upper half of Shoff 226 227 for J in 1 .. 4 loop 228 Get_Byte (B); 229 end loop; 230 231 -- Skip e_flags 232 233 Get_Word (W); 234 235 -- Skip e_ehsize 236 237 Skip_Half; 238 239 -- Skip e_phentsize 240 241 Skip_Half; 242 243 -- Skip e_phnum 244 245 Skip_Half; 246 247 Get_Half (Shentsize); 248 249 Get_Half (Shnum); 250 251 Section_Headers := new Section_Header_Array (0 .. Shnum - 1); 252 253 -- Go to Section Headers 254 255 while Offset < Shoff loop 256 Get_Byte (B); 257 end loop; 258 259 -- Reset Symtab_Index 260 261 Symtab_Index := 0; 262 263 for J in Section_Headers'Range loop 264 265 -- Get the data for each Section Header 266 267 Get_Word (Shname); 268 Get_Word (Shtype); 269 270 for K in 1 .. 16 loop 271 Get_Byte (B); 272 end loop; 273 274 Get_Word (Shoffset); 275 Get_Word (W); 276 277 Get_Word (Shsize); 278 Get_Word (W); 279 280 Get_Word (Shlink); 281 282 while (Offset - Shoff) mod Shentsize /= 0 loop 283 Get_Byte (B); 284 end loop; 285 286 -- If this is the Symbol Table Section Header, record its index 287 288 if Shtype = 2 then 289 Symtab_Index := J; 290 end if; 291 292 Section_Headers (J) := (Shname, Shtype, Shoffset, Shsize, Shlink); 293 end loop; 294 295 if Symtab_Index = 0 then 296 Success := False; 297 return; 298 end if; 299 300 End_Symtab := 301 Section_Headers (Symtab_Index).Shoffset + 302 Section_Headers (Symtab_Index).Shsize; 303 304 String_Table_Index := Section_Headers (Symtab_Index).Shlink; 305 Strings := 306 new String_Array (1 .. Section_Headers (String_Table_Index).Shsize); 307 308 -- Go get the String Table section for the Symbol Table 309 310 Reset; 311 312 while Offset < Section_Headers (String_Table_Index).Shoffset loop 313 Get_Byte (B); 314 end loop; 315 316 Offset := 0; 317 318 Get_Byte (B); -- zero 319 320 while Offset < Section_Headers (String_Table_Index).Shsize loop 321 Str_Last := 0; 322 323 loop 324 Get_Byte (B); 325 if B /= ASCII.NUL then 326 Str_Last := Str_Last + 1; 327 Str (Str_Last) := B; 328 329 else 330 Strings (Offset - Str_Last - 1) := 331 new String'(Str (1 .. Str_Last)); 332 exit; 333 end if; 334 end loop; 335 end loop; 336 337 -- Go get the Symbol Table 338 339 Reset; 340 341 while Offset < Section_Headers (Symtab_Index).Shoffset loop 342 Get_Byte (B); 343 end loop; 344 345 while Offset < End_Symtab loop 346 Get_Word (Stname); 347 Get_Byte (Stinfo); 348 Get_Byte (Stother); 349 Get_Half (Stshndx); 350 for J in 1 .. 4 loop 351 Get_Word (W); 352 end loop; 353 354 Sttype := Integer'(Character'Pos (Stinfo)) mod 16; 355 Stbind := Integer'(Character'Pos (Stinfo)) / 16; 356 Stvis := Integer'(Character'Pos (Stother)) mod 4; 357 358 if (Sttype = 1 or else Sttype = 2) 359 and then Stbind /= 0 360 and then Stshndx /= 0 361 and then Stvis /= STV_Internal 362 and then Stvis /= STV_Hidden 363 then 364 -- Check if this is a symbol from a generic body 365 366 OK := True; 367 368 for J in Strings (Stname)'First .. Strings (Stname)'Last - 2 loop 369 if Strings (Stname) (J) = 'G' 370 and then Strings (Stname) (J + 1) = 'P' 371 and then Strings (Stname) (J + 2) in '0' .. '9' 372 then 373 OK := False; 374 exit; 375 end if; 376 end loop; 377 378 if OK then 379 declare 380 S_Data : Symbol_Data; 381 begin 382 S_Data.Name := new String'(Strings (Stname).all); 383 384 if Sttype = 1 then 385 S_Data.Kind := Data; 386 387 else 388 S_Data.Kind := Proc; 389 end if; 390 391 -- Put the new symbol in the table 392 393 Symbol_Table.Append (Complete_Symbols, S_Data); 394 end; 395 end if; 396 end if; 397 end loop; 398 399 -- The object file has been processed, close it 400 401 Close (File); 402 403 -- Free the allocated memory 404 405 Free (Section_Headers); 406 407 for J in Strings'Range loop 408 if Strings (J) /= null then 409 Free (Strings (J)); 410 end if; 411 end loop; 412 413 Free (Strings); 414 415 exception 416 -- For any exception, output an error message, close the object file 417 -- and return with Success = False. 418 419 when Ada.IO_Exceptions.End_Error => 420 Close (File); 421 422 when X : others => 423 Put_Line ("unexpected exception raised while processing """ 424 & Object_File & """"); 425 Put_Line (Exception_Information (X)); 426 Close (File); 427 Success := False; 428 end Process; 429 430end Processing; 431