1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- S Y M B O L S -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2003-2007, 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 version of this package 27 28with Ada.Exceptions; use Ada.Exceptions; 29with Ada.Sequential_IO; 30with Ada.Text_IO; use Ada.Text_IO; 31 32package body Symbols is 33 34 Case_Sensitive : constant String := "case_sensitive="; 35 Symbol_Vector : constant String := "SYMBOL_VECTOR=("; 36 Equal_Data : constant String := "=DATA)"; 37 Equal_Procedure : constant String := "=PROCEDURE)"; 38 Gsmatch : constant String := "gsmatch="; 39 Gsmatch_Lequal : constant String := "gsmatch=lequal,"; 40 41 Symbol_File_Name : String_Access := null; 42 -- Name of the symbol file 43 44 Long_Symbol_Length : constant := 100; 45 -- Magic length of symbols, over which the lines are split 46 47 Sym_Policy : Policy := Autonomous; 48 -- The symbol policy. Set by Initialize 49 50 Major_ID : Integer := 1; 51 -- The Major ID. May be modified by Initialize if Library_Version is 52 -- specified or if it is read from the reference symbol file. 53 54 Soft_Major_ID : Boolean := True; 55 -- False if library version is specified in procedure Initialize. 56 -- When True, Major_ID may be modified if found in the reference symbol 57 -- file. 58 59 Minor_ID : Natural := 0; 60 -- The Minor ID. May be modified if read from the reference symbol file 61 62 Soft_Minor_ID : Boolean := True; 63 -- False if symbol policy is Autonomous, if library version is specified 64 -- in procedure Initialize and is not the same as the major ID read from 65 -- the reference symbol file. When True, Minor_ID may be increased in 66 -- Compliant symbol policy. 67 68 subtype Byte is Character; 69 -- Object files are stream of bytes, but some of these bytes, those for 70 -- the names of the symbols, are ASCII characters. 71 72 package Byte_IO is new Ada.Sequential_IO (Byte); 73 use Byte_IO; 74 75 File : Byte_IO.File_Type; 76 -- Each object file is read as a stream of bytes (characters) 77 78 function Equal (Left, Right : Symbol_Data) return Boolean; 79 -- Test for equality of symbols 80 81 function Image (N : Integer) return String; 82 -- Returns the image of N, without the initial space 83 84 ----------- 85 -- Equal -- 86 ----------- 87 88 function Equal (Left, Right : Symbol_Data) return Boolean is 89 begin 90 return Left.Name /= null and then 91 Right.Name /= null and then 92 Left.Name.all = Right.Name.all and then 93 Left.Kind = Right.Kind and then 94 Left.Present = Right.Present; 95 end Equal; 96 97 ----------- 98 -- Image -- 99 ----------- 100 101 function Image (N : Integer) return String is 102 Result : constant String := N'Img; 103 begin 104 if Result (Result'First) = ' ' then 105 return Result (Result'First + 1 .. Result'Last); 106 else 107 return Result; 108 end if; 109 end Image; 110 111 ---------------- 112 -- Initialize -- 113 ---------------- 114 115 procedure Initialize 116 (Symbol_File : String; 117 Reference : String; 118 Symbol_Policy : Policy; 119 Quiet : Boolean; 120 Version : String; 121 Success : out Boolean) 122 is 123 File : Ada.Text_IO.File_Type; 124 Line : String (1 .. 2_000); 125 Last : Natural; 126 127 Offset : Natural; 128 129 begin 130 -- Record the symbol file name 131 132 Symbol_File_Name := new String'(Symbol_File); 133 134 -- Record the policy 135 136 Sym_Policy := Symbol_Policy; 137 138 -- Record the version (Major ID) 139 140 if Version = "" then 141 Major_ID := 1; 142 Soft_Major_ID := True; 143 144 else 145 begin 146 Major_ID := Integer'Value (Version); 147 Soft_Major_ID := False; 148 149 if Major_ID <= 0 then 150 raise Constraint_Error; 151 end if; 152 153 exception 154 when Constraint_Error => 155 if not Quiet then 156 Put_Line ("Version """ & Version & """ is illegal."); 157 Put_Line ("On VMS, version must be a positive number"); 158 end if; 159 160 Success := False; 161 return; 162 end; 163 end if; 164 165 Minor_ID := 0; 166 Soft_Minor_ID := Sym_Policy /= Autonomous; 167 168 -- Empty the symbol tables 169 170 Symbol_Table.Set_Last (Original_Symbols, 0); 171 Symbol_Table.Set_Last (Complete_Symbols, 0); 172 173 -- Assume that everything will be fine 174 175 Success := True; 176 177 -- If policy is Compliant or Controlled, attempt to read the reference 178 -- file. If policy is Restricted, attempt to read the symbol file. 179 180 if Sym_Policy /= Autonomous then 181 case Sym_Policy is 182 when Autonomous | Direct => 183 null; 184 185 when Compliant | Controlled => 186 begin 187 Open (File, In_File, Reference); 188 189 exception 190 when Ada.Text_IO.Name_Error => 191 Success := False; 192 return; 193 194 when X : others => 195 if not Quiet then 196 Put_Line ("could not open """ & Reference & """"); 197 Put_Line (Exception_Message (X)); 198 end if; 199 200 Success := False; 201 return; 202 end; 203 204 when Restricted => 205 begin 206 Open (File, In_File, Symbol_File); 207 208 exception 209 when Ada.Text_IO.Name_Error => 210 Success := False; 211 return; 212 213 when X : others => 214 if not Quiet then 215 Put_Line ("could not open """ & Symbol_File & """"); 216 Put_Line (Exception_Message (X)); 217 end if; 218 219 Success := False; 220 return; 221 end; 222 end case; 223 224 -- Read line by line 225 226 while not End_Of_File (File) loop 227 Offset := 0; 228 loop 229 Get_Line (File, Line (Offset + 1 .. Line'Last), Last); 230 exit when Line (Last) /= '-'; 231 232 if End_Of_File (File) then 233 if not Quiet then 234 Put_Line ("symbol file """ & Reference & 235 """ is incorrectly formatted:"); 236 Put_Line ("""" & Line (1 .. Last) & """"); 237 end if; 238 239 Close (File); 240 Success := False; 241 return; 242 243 else 244 Offset := Last - 1; 245 end if; 246 end loop; 247 248 -- Ignore empty lines 249 250 if Last = 0 then 251 null; 252 253 -- Ignore lines starting with "case_sensitive=" 254 255 elsif Last > Case_Sensitive'Length 256 and then Line (1 .. Case_Sensitive'Length) = Case_Sensitive 257 then 258 null; 259 260 -- Line starting with "SYMBOL_VECTOR=(" 261 262 elsif Last > Symbol_Vector'Length 263 and then Line (1 .. Symbol_Vector'Length) = Symbol_Vector 264 then 265 266 -- SYMBOL_VECTOR=(<symbol>=DATA) 267 268 if Last > Symbol_Vector'Length + Equal_Data'Length and then 269 Line (Last - Equal_Data'Length + 1 .. Last) = Equal_Data 270 then 271 Symbol_Table.Append (Original_Symbols, 272 (Name => 273 new String'(Line (Symbol_Vector'Length + 1 .. 274 Last - Equal_Data'Length)), 275 Kind => Data, 276 Present => True)); 277 278 -- SYMBOL_VECTOR=(<symbol>=PROCEDURE) 279 280 elsif Last > Symbol_Vector'Length + Equal_Procedure'Length 281 and then 282 Line (Last - Equal_Procedure'Length + 1 .. Last) = 283 Equal_Procedure 284 then 285 Symbol_Table.Append (Original_Symbols, 286 (Name => 287 new String'(Line (Symbol_Vector'Length + 1 .. 288 Last - Equal_Procedure'Length)), 289 Kind => Proc, 290 Present => True)); 291 292 -- Anything else is incorrectly formatted 293 294 else 295 if not Quiet then 296 Put_Line ("symbol file """ & Reference & 297 """ is incorrectly formatted:"); 298 Put_Line ("""" & Line (1 .. Last) & """"); 299 end if; 300 301 Close (File); 302 Success := False; 303 return; 304 end if; 305 306 -- Lines with "gsmatch=lequal," or "gsmatch=equal," 307 308 elsif Last > Gsmatch'Length 309 and then Line (1 .. Gsmatch'Length) = Gsmatch 310 then 311 declare 312 Start : Positive := Gsmatch'Length + 1; 313 Finish : Positive := Start; 314 OK : Boolean := True; 315 ID : Integer; 316 317 begin 318 -- First, look for the first coma 319 320 loop 321 if Start >= Last - 1 then 322 OK := False; 323 exit; 324 325 elsif Line (Start) = ',' then 326 Start := Start + 1; 327 exit; 328 329 else 330 Start := Start + 1; 331 end if; 332 end loop; 333 334 Finish := Start; 335 336 -- If the comma is found, get the Major and the Minor IDs 337 338 if OK then 339 loop 340 if Line (Finish) not in '0' .. '9' 341 or else Finish >= Last - 1 342 then 343 OK := False; 344 exit; 345 end if; 346 347 exit when Line (Finish + 1) = ','; 348 349 Finish := Finish + 1; 350 end loop; 351 end if; 352 353 if OK then 354 ID := Integer'Value (Line (Start .. Finish)); 355 OK := ID /= 0; 356 357 -- If Soft_Major_ID is True, it means that 358 -- Library_Version was not specified. 359 360 if Soft_Major_ID then 361 Major_ID := ID; 362 363 -- If the Major ID in the reference file is different 364 -- from the Library_Version, then the Minor ID will be 0 365 -- because there is no point in taking the Minor ID in 366 -- the reference file, or incrementing it. So, we set 367 -- Soft_Minor_ID to False, so that we don't modify 368 -- the Minor_ID later. 369 370 elsif Major_ID /= ID then 371 Soft_Minor_ID := False; 372 end if; 373 374 Start := Finish + 2; 375 Finish := Start; 376 377 loop 378 if Line (Finish) not in '0' .. '9' then 379 OK := False; 380 exit; 381 end if; 382 383 exit when Finish = Last; 384 385 Finish := Finish + 1; 386 end loop; 387 388 -- Only set Minor_ID if Soft_Minor_ID is True (see above) 389 390 if OK and then Soft_Minor_ID then 391 Minor_ID := Integer'Value (Line (Start .. Finish)); 392 end if; 393 end if; 394 395 -- If OK is not True, that means the line is not correctly 396 -- formatted. 397 398 if not OK then 399 if not Quiet then 400 Put_Line ("symbol file """ & Reference & 401 """ is incorrectly formatted"); 402 Put_Line ("""" & Line (1 .. Last) & """"); 403 end if; 404 405 Close (File); 406 Success := False; 407 return; 408 end if; 409 end; 410 411 -- Anything else is incorrectly formatted 412 413 else 414 if not Quiet then 415 Put_Line ("unexpected line in symbol file """ & 416 Reference & """"); 417 Put_Line ("""" & Line (1 .. Last) & """"); 418 end if; 419 420 Close (File); 421 Success := False; 422 return; 423 end if; 424 end loop; 425 426 Close (File); 427 end if; 428 end Initialize; 429 430 ---------------- 431 -- Processing -- 432 ---------------- 433 434 package body Processing is separate; 435 436 -------------- 437 -- Finalize -- 438 -------------- 439 440 procedure Finalize 441 (Quiet : Boolean; 442 Success : out Boolean) 443 is 444 File : Ada.Text_IO.File_Type; 445 -- The symbol file 446 447 S_Data : Symbol_Data; 448 -- A symbol 449 450 Cur : Positive := 1; 451 -- Most probable index in the Complete_Symbols of the current symbol 452 -- in Original_Symbol. 453 454 Found : Boolean; 455 456 begin 457 -- Nothing to be done if Initialize has never been called 458 459 if Symbol_File_Name = null then 460 Success := False; 461 462 else 463 464 -- First find if the symbols in the reference symbol file are also 465 -- in the object files. Note that this is not done if the policy is 466 -- Autonomous, because no reference symbol file has been read. 467 468 -- Expect the first symbol in the symbol file to also be the first 469 -- in Complete_Symbols. 470 471 Cur := 1; 472 473 for Index_1 in 1 .. Symbol_Table.Last (Original_Symbols) loop 474 S_Data := Original_Symbols.Table (Index_1); 475 Found := False; 476 477 First_Object_Loop : 478 for Index_2 in Cur .. Symbol_Table.Last (Complete_Symbols) loop 479 if Equal (S_Data, Complete_Symbols.Table (Index_2)) then 480 Cur := Index_2 + 1; 481 Complete_Symbols.Table (Index_2).Present := False; 482 Found := True; 483 exit First_Object_Loop; 484 end if; 485 end loop First_Object_Loop; 486 487 -- If the symbol could not be found between Cur and Last, try 488 -- before Cur. 489 490 if not Found then 491 Second_Object_Loop : 492 for Index_2 in 1 .. Cur - 1 loop 493 if Equal (S_Data, Complete_Symbols.Table (Index_2)) then 494 Cur := Index_2 + 1; 495 Complete_Symbols.Table (Index_2).Present := False; 496 Found := True; 497 exit Second_Object_Loop; 498 end if; 499 end loop Second_Object_Loop; 500 end if; 501 502 -- If the symbol is not found, mark it as such in the table 503 504 if not Found then 505 if (not Quiet) or else Sym_Policy = Controlled then 506 Put_Line ("symbol """ & S_Data.Name.all & 507 """ is no longer present in the object files"); 508 end if; 509 510 if Sym_Policy = Controlled or else Sym_Policy = Restricted then 511 Success := False; 512 return; 513 514 -- Any symbol that is undefined in the reference symbol file 515 -- triggers an increase of the Major ID, because the new 516 -- version of the library is no longer compatible with 517 -- existing executables. 518 519 elsif Soft_Major_ID then 520 Major_ID := Major_ID + 1; 521 Minor_ID := 0; 522 Soft_Major_ID := False; 523 Soft_Minor_ID := False; 524 end if; 525 526 Original_Symbols.Table (Index_1).Present := False; 527 Free (Original_Symbols.Table (Index_1).Name); 528 529 if Soft_Minor_ID then 530 Minor_ID := Minor_ID + 1; 531 Soft_Minor_ID := False; 532 end if; 533 end if; 534 end loop; 535 536 if Sym_Policy /= Restricted then 537 538 -- Append additional symbols, if any, to the Original_Symbols 539 -- table. 540 541 for Index in 1 .. Symbol_Table.Last (Complete_Symbols) loop 542 S_Data := Complete_Symbols.Table (Index); 543 544 if S_Data.Present then 545 546 if Sym_Policy = Controlled then 547 Put_Line ("symbol """ & S_Data.Name.all & 548 """ is not in the reference symbol file"); 549 Success := False; 550 return; 551 552 elsif Soft_Minor_ID then 553 Minor_ID := Minor_ID + 1; 554 Soft_Minor_ID := False; 555 end if; 556 557 Symbol_Table.Append (Original_Symbols, S_Data); 558 Complete_Symbols.Table (Index).Present := False; 559 end if; 560 end loop; 561 562 -- Create the symbol file 563 564 Create (File, Ada.Text_IO.Out_File, Symbol_File_Name.all); 565 566 Put (File, Case_Sensitive); 567 Put_Line (File, "yes"); 568 569 -- Put a line in the symbol file for each symbol in symbol table 570 571 for Index in 1 .. Symbol_Table.Last (Original_Symbols) loop 572 if Original_Symbols.Table (Index).Present then 573 Put (File, Symbol_Vector); 574 575 -- Split the line if symbol name length is too large 576 577 if Original_Symbols.Table (Index).Name'Length > 578 Long_Symbol_Length 579 then 580 Put_Line (File, "-"); 581 end if; 582 583 Put (File, Original_Symbols.Table (Index).Name.all); 584 585 if Original_Symbols.Table (Index).Name'Length > 586 Long_Symbol_Length 587 then 588 Put_Line (File, "-"); 589 end if; 590 591 if Original_Symbols.Table (Index).Kind = Data then 592 Put_Line (File, Equal_Data); 593 594 else 595 Put_Line (File, Equal_Procedure); 596 end if; 597 598 Free (Original_Symbols.Table (Index).Name); 599 end if; 600 end loop; 601 602 Put (File, Case_Sensitive); 603 Put_Line (File, "NO"); 604 605 -- Put the version IDs 606 607 Put (File, Gsmatch_Lequal); 608 Put (File, Image (Major_ID)); 609 Put (File, ','); 610 Put_Line (File, Image (Minor_ID)); 611 612 -- And we are done 613 614 Close (File); 615 616 -- Reset both tables 617 618 Symbol_Table.Set_Last (Original_Symbols, 0); 619 Symbol_Table.Set_Last (Complete_Symbols, 0); 620 621 -- Clear the symbol file name 622 623 Free (Symbol_File_Name); 624 end if; 625 626 Success := True; 627 end if; 628 629 exception 630 when X : others => 631 Put_Line ("unexpected exception raised while finalizing """ 632 & Symbol_File_Name.all & """"); 633 Put_Line (Exception_Information (X)); 634 Success := False; 635 end Finalize; 636 637end Symbols; 638