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) 2003-2010, 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 Alpha version of this package 27 28separate (Symbols) 29package body Processing is 30 31 type Number is mod 2**16; 32 -- 16 bits unsigned number for number of characters 33 34 EMH : constant Number := 8; 35 -- Code for the Module Header section 36 37 GSD : constant Number := 10; 38 -- Code for the Global Symbol Definition section 39 40 C_SYM : constant Number := 1; 41 -- Code for a Symbol subsection 42 43 V_DEF_Mask : constant Number := 2 ** 1; 44 V_NORM_Mask : constant Number := 2 ** 6; 45 -- Comments ??? 46 47 B : Byte; 48 49 Number_Of_Characters : Natural := 0; 50 -- The number of characters of each section 51 52 Native_Format : Boolean; 53 -- True if records are decoded by the system (like on VMS) 54 55 Has_Pad : Boolean; 56 -- If true, a pad byte must be skipped before reading the next record 57 58 -- The following variables are used by procedure Process when reading an 59 -- object file. 60 61 Code : Number := 0; 62 Length : Natural := 0; 63 64 Dummy : Number; 65 66 Nchars : Natural := 0; 67 Flags : Number := 0; 68 69 Symbol : String (1 .. 255); 70 LSymb : Natural; 71 72 procedure Get (N : out Number); 73 -- Read two bytes from the object file LSB first as unsigned 16 bit number 74 75 procedure Get (N : out Natural); 76 -- Read two bytes from the object file, LSByte first, as a Natural 77 78 --------- 79 -- Get -- 80 --------- 81 82 procedure Get (N : out Number) is 83 C : Byte; 84 LSByte : Number; 85 begin 86 Read (File, C); 87 LSByte := Byte'Pos (C); 88 Read (File, C); 89 N := LSByte + (256 * Byte'Pos (C)); 90 end Get; 91 92 procedure Get (N : out Natural) is 93 Result : Number; 94 begin 95 Get (Result); 96 N := Natural (Result); 97 end Get; 98 99 ------------- 100 -- Process -- 101 ------------- 102 103 procedure Process 104 (Object_File : String; 105 Success : out Boolean) 106 is 107 OK : Boolean := True; 108 109 begin 110 -- Open the object file with Byte_IO. Return with Success = False if 111 -- this fails. 112 113 begin 114 Open (File, In_File, Object_File); 115 exception 116 when others => 117 Put_Line 118 ("*** Unable to open object file """ & Object_File & """"); 119 Success := False; 120 return; 121 end; 122 123 -- Assume that the object file has a correct format 124 125 Success := True; 126 127 -- Check the file format in case of cross-tool 128 129 Get (Code); 130 Get (Number_Of_Characters); 131 Get (Dummy); 132 133 if Code = Dummy and then Number_Of_Characters = Natural (EMH) then 134 135 -- Looks like a cross tool 136 137 Native_Format := False; 138 Number_Of_Characters := Natural (Dummy) - 4; 139 Has_Pad := (Number_Of_Characters mod 2) = 1; 140 141 elsif Code = EMH then 142 Native_Format := True; 143 Number_Of_Characters := Number_Of_Characters - 6; 144 Has_Pad := False; 145 146 else 147 Put_Line ("file """ & Object_File & """ is not an object file"); 148 Close (File); 149 Success := False; 150 return; 151 end if; 152 153 -- Skip the EMH section 154 155 for J in 1 .. Number_Of_Characters loop 156 Read (File, B); 157 end loop; 158 159 -- Get the different sections one by one from the object file 160 161 while not End_Of_File (File) loop 162 163 if not Native_Format then 164 165 -- Skip pad byte if present 166 167 if Has_Pad then 168 Get (B); 169 end if; 170 171 -- Skip record length 172 173 Get (Dummy); 174 end if; 175 176 Get (Code); 177 Get (Number_Of_Characters); 178 179 if not Native_Format then 180 if Natural (Dummy) /= Number_Of_Characters then 181 182 -- Format error 183 184 raise Constraint_Error; 185 end if; 186 187 Has_Pad := (Number_Of_Characters mod 2) = 1; 188 end if; 189 190 -- The header is 4 bytes length 191 192 Number_Of_Characters := Number_Of_Characters - 4; 193 194 -- If this is not a Global Symbol Definition section, skip to the 195 -- next section. 196 197 if Code /= GSD then 198 for J in 1 .. Number_Of_Characters loop 199 Read (File, B); 200 end loop; 201 202 else 203 -- Skip over the next 4 bytes 204 205 Get (Dummy); 206 Get (Dummy); 207 Number_Of_Characters := Number_Of_Characters - 4; 208 209 -- Get each subsection in turn 210 211 loop 212 Get (Code); 213 Get (Nchars); 214 Get (Dummy); 215 Get (Flags); 216 Number_Of_Characters := Number_Of_Characters - 8; 217 Nchars := Nchars - 8; 218 219 -- If this is a symbol and the V_DEF flag is set, get symbol 220 221 if Code = C_SYM and then ((Flags and V_DEF_Mask) /= 0) then 222 223 -- First, reach the symbol length 224 225 for J in 1 .. 25 loop 226 Read (File, B); 227 Nchars := Nchars - 1; 228 Number_Of_Characters := Number_Of_Characters - 1; 229 end loop; 230 231 Length := Byte'Pos (B); 232 LSymb := 0; 233 234 -- Get the symbol characters 235 236 for J in 1 .. Nchars loop 237 Read (File, B); 238 Number_Of_Characters := Number_Of_Characters - 1; 239 240 if Length > 0 then 241 LSymb := LSymb + 1; 242 Symbol (LSymb) := B; 243 Length := Length - 1; 244 end if; 245 end loop; 246 247 -- Check if it is a symbol from a generic body 248 249 OK := True; 250 251 for J in 1 .. LSymb - 2 loop 252 if Symbol (J) = 'G' and then Symbol (J + 1) = 'P' 253 and then Symbol (J + 2) in '0' .. '9' 254 then 255 OK := False; 256 exit; 257 end if; 258 end loop; 259 260 if OK then 261 262 -- Create the new Symbol 263 264 declare 265 S_Data : Symbol_Data; 266 267 begin 268 S_Data.Name := new String'(Symbol (1 .. LSymb)); 269 270 -- The symbol kind (Data or Procedure) depends on the 271 -- V_NORM flag. 272 273 if (Flags and V_NORM_Mask) = 0 then 274 S_Data.Kind := Data; 275 else 276 S_Data.Kind := Proc; 277 end if; 278 279 -- Put the new symbol in the table 280 281 Symbol_Table.Append (Complete_Symbols, S_Data); 282 end; 283 end if; 284 285 else 286 -- As it is not a symbol subsection, skip to the next 287 -- subsection. 288 289 for J in 1 .. Nchars loop 290 Read (File, B); 291 Number_Of_Characters := Number_Of_Characters - 1; 292 end loop; 293 end if; 294 295 -- Exit the GSD section when number of characters reaches zero 296 297 exit when Number_Of_Characters = 0; 298 end loop; 299 end if; 300 end loop; 301 302 -- The object file has been processed, close it 303 304 Close (File); 305 306 exception 307 -- For any exception, output an error message, close the object file 308 -- and return with Success = False. 309 310 when X : others => 311 Put_Line ("unexpected exception raised while processing """ 312 & Object_File & """"); 313 Put_Line (Exception_Information (X)); 314 Close (File); 315 Success := False; 316 end Process; 317 318end Processing; 319