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 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 2, 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 COPYING. If not, write -- 19-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- 20-- MA 02111-1307, USA. -- 21-- -- 22-- GNAT was originally developed by the GNAT team at New York University. -- 23-- Extensive contributions were provided by Ada Core Technologies Inc. -- 24-- -- 25------------------------------------------------------------------------------ 26 27-- This is the VMS version of this package 28 29with Ada.Exceptions; use Ada.Exceptions; 30with Ada.Sequential_IO; 31with Ada.Text_IO; use Ada.Text_IO; 32 33package body Symbols is 34 35 Case_Sensitive : constant String := "case_sensitive="; 36 Symbol_Vector : constant String := "SYMBOL_VECTOR=("; 37 Equal_Data : constant String := "=DATA)"; 38 Equal_Procedure : constant String := "=PROCEDURE)"; 39 Gsmatch : constant String := "gsmatch=equal,"; 40 41 Symbol_File_Name : String_Access := null; 42 -- Name of the symbol file 43 44 Sym_Policy : Policy := Autonomous; 45 -- The symbol policy. Set by Initialize 46 47 Major_ID : Integer := 1; 48 -- The Major ID. May be modified by Initialize if Library_Version is 49 -- specified or if it is read from the reference symbol file. 50 51 Soft_Major_ID : Boolean := True; 52 -- False if library version is specified in procedure Initialize. 53 -- When True, Major_ID may be modified if found in the reference symbol 54 -- file. 55 56 Minor_ID : Natural := 0; 57 -- The Minor ID. May be modified if read from the reference symbol file 58 59 Soft_Minor_ID : Boolean := True; 60 -- False if symbol policy is Autonomous, if library version is specified 61 -- in procedure Initialize and is not the same as the major ID read from 62 -- the reference symbol file. When True, Minor_ID may be increased in 63 -- Compliant symbol policy. 64 65 subtype Byte is Character; 66 -- Object files are stream of bytes, but some of these bytes, those for 67 -- the names of the symbols, are ASCII characters. 68 69 package Byte_IO is new Ada.Sequential_IO (Byte); 70 use Byte_IO; 71 72 type Number is mod 2**16; 73 -- 16 bits unsigned number for number of characters 74 75 GSD : constant Number := 10; 76 -- Code for the Global Symbol Definition section 77 78 C_SYM : constant Number := 1; 79 -- Code for a Symbol subsection 80 81 V_DEF_Mask : constant Number := 2**1; 82 V_NORM_Mask : constant Number := 2**6; 83 84 File : Byte_IO.File_Type; 85 -- Each object file is read as a stream of bytes (characters) 86 87 B : Byte; 88 89 Number_Of_Characters : Natural := 0; 90 -- The number of characters of each section 91 92 -- The following variables are used by procedure Process when reading an 93 -- object file. 94 95 Code : Number := 0; 96 Length : Natural := 0; 97 98 Dummy : Number; 99 100 Nchars : Natural := 0; 101 Flags : Number := 0; 102 103 Symbol : String (1 .. 255); 104 LSymb : Natural; 105 106 function Equal (Left, Right : Symbol_Data) return Boolean; 107 -- Test for equality of symbols 108 109 procedure Get (N : out Number); 110 -- Read two bytes from the object file LSB first as unsigned 16 bit number 111 112 procedure Get (N : out Natural); 113 -- Read two bytes from the object file, LSByte first, as a Natural 114 115 116 function Image (N : Integer) return String; 117 -- Returns the image of N, without the initial space 118 119 ----------- 120 -- Equal -- 121 ----------- 122 123 function Equal (Left, Right : Symbol_Data) return Boolean is 124 begin 125 return Left.Name /= null and then 126 Right.Name /= null and then 127 Left.Name.all = Right.Name.all and then 128 Left.Kind = Right.Kind and then 129 Left.Present = Right.Present; 130 end Equal; 131 132 --------- 133 -- Get -- 134 --------- 135 136 procedure Get (N : out Number) is 137 C : Byte; 138 LSByte : Number; 139 begin 140 Read (File, C); 141 LSByte := Byte'Pos (C); 142 Read (File, C); 143 N := LSByte + (256 * Byte'Pos (C)); 144 end Get; 145 146 procedure Get (N : out Natural) is 147 Result : Number; 148 begin 149 Get (Result); 150 N := Natural (Result); 151 end Get; 152 153 ----------- 154 -- Image -- 155 ----------- 156 157 function Image (N : Integer) return String is 158 Result : constant String := N'Img; 159 begin 160 if Result (Result'First) = ' ' then 161 return Result (Result'First + 1 .. Result'Last); 162 163 else 164 return Result; 165 end if; 166 end Image; 167 168 ---------------- 169 -- Initialize -- 170 ---------------- 171 172 procedure Initialize 173 (Symbol_File : String; 174 Reference : String; 175 Symbol_Policy : Policy; 176 Quiet : Boolean; 177 Version : String; 178 Success : out Boolean) 179 is 180 File : Ada.Text_IO.File_Type; 181 Line : String (1 .. 1_000); 182 Last : Natural; 183 184 begin 185 -- Record the symbol file name 186 187 Symbol_File_Name := new String'(Symbol_File); 188 189 -- Record the policy 190 191 Sym_Policy := Symbol_Policy; 192 193 -- Record the version (Major ID) 194 195 if Version = "" then 196 Major_ID := 1; 197 Soft_Major_ID := True; 198 199 else 200 begin 201 Major_ID := Integer'Value (Version); 202 Soft_Major_ID := False; 203 204 if Major_ID <= 0 then 205 raise Constraint_Error; 206 end if; 207 208 exception 209 when Constraint_Error => 210 if not Quiet then 211 Put_Line ("Version """ & Version & """ is illegal."); 212 Put_Line ("On VMS, version must be a positive number"); 213 end if; 214 215 Success := False; 216 return; 217 end; 218 end if; 219 220 Minor_ID := 0; 221 Soft_Minor_ID := Sym_Policy /= Autonomous; 222 223 -- Empty the symbol tables 224 225 Symbol_Table.Set_Last (Original_Symbols, 0); 226 Symbol_Table.Set_Last (Complete_Symbols, 0); 227 228 -- Assume that everything will be fine 229 230 Success := True; 231 232 -- If policy is not autonomous, attempt to read the reference file 233 234 if Sym_Policy /= Autonomous then 235 begin 236 Open (File, In_File, Reference); 237 238 exception 239 when Ada.Text_IO.Name_Error => 240 return; 241 242 when X : others => 243 if not Quiet then 244 Put_Line ("could not open """ & Reference & """"); 245 Put_Line (Exception_Message (X)); 246 end if; 247 248 Success := False; 249 return; 250 end; 251 252 -- Read line by line 253 254 while not End_Of_File (File) loop 255 Get_Line (File, Line, Last); 256 257 -- Ignore empty lines 258 259 if Last = 0 then 260 null; 261 262 -- Ignore lines starting with "case_sensitive=" 263 264 elsif Last > Case_Sensitive'Length 265 and then Line (1 .. Case_Sensitive'Length) = Case_Sensitive 266 then 267 null; 268 269 -- Line starting with "SYMBOL_VECTOR=(" 270 271 elsif Last > Symbol_Vector'Length 272 and then Line (1 .. Symbol_Vector'Length) = Symbol_Vector 273 then 274 275 -- SYMBOL_VECTOR=(<symbol>=DATA) 276 277 if Last > Symbol_Vector'Length + Equal_Data'Length and then 278 Line (Last - Equal_Data'Length + 1 .. Last) = Equal_Data 279 then 280 Symbol_Table.Increment_Last (Original_Symbols); 281 Original_Symbols.Table 282 (Symbol_Table.Last (Original_Symbols)) := 283 (Name => 284 new String'(Line (Symbol_Vector'Length + 1 .. 285 Last - Equal_Data'Length)), 286 Kind => Data, 287 Present => True); 288 289 -- SYMBOL_VECTOR=(<symbol>=PROCEDURE) 290 291 elsif Last > Symbol_Vector'Length + Equal_Procedure'Length 292 and then 293 Line (Last - Equal_Procedure'Length + 1 .. Last) = 294 Equal_Procedure 295 then 296 Symbol_Table.Increment_Last (Original_Symbols); 297 Original_Symbols.Table 298 (Symbol_Table.Last (Original_Symbols)) := 299 (Name => 300 new String'(Line (Symbol_Vector'Length + 1 .. 301 Last - Equal_Procedure'Length)), 302 Kind => Proc, 303 Present => True); 304 305 -- Anything else is incorrectly formatted 306 307 else 308 if not Quiet then 309 Put_Line ("symbol file """ & Reference & 310 """ is incorrectly formatted:"); 311 Put_Line ("""" & Line (1 .. Last) & """"); 312 end if; 313 314 Close (File); 315 Success := False; 316 return; 317 end if; 318 319 -- Lines with "gsmatch=equal,<Major_ID>,<Minor_Id> 320 321 elsif Last > Gsmatch'Length 322 and then Line (1 .. Gsmatch'Length) = Gsmatch 323 then 324 declare 325 Start : Positive := Gsmatch'Length + 1; 326 Finish : Positive := Start; 327 OK : Boolean := True; 328 ID : Integer; 329 330 begin 331 loop 332 if Line (Finish) not in '0' .. '9' 333 or else Finish >= Last - 1 334 then 335 OK := False; 336 exit; 337 end if; 338 339 exit when Line (Finish + 1) = ','; 340 341 Finish := Finish + 1; 342 end loop; 343 344 if OK then 345 ID := Integer'Value (Line (Start .. Finish)); 346 OK := ID /= 0; 347 348 -- If Soft_Major_ID is True, it means that 349 -- Library_Version was not specified. 350 351 if Soft_Major_ID then 352 Major_ID := ID; 353 354 -- If the Major ID in the reference file is different 355 -- from the Library_Version, then the Minor ID will be 0 356 -- because there is no point in taking the Minor ID in 357 -- the reference file, or incrementing it. So, we set 358 -- Soft_Minor_ID to False, so that we don't modify 359 -- the Minor_ID later. 360 361 elsif Major_ID /= ID then 362 Soft_Minor_ID := False; 363 end if; 364 365 Start := Finish + 2; 366 Finish := Start; 367 368 loop 369 if Line (Finish) not in '0' .. '9' then 370 OK := False; 371 exit; 372 end if; 373 374 exit when Finish = Last; 375 376 Finish := Finish + 1; 377 end loop; 378 379 -- Only set Minor_ID if Soft_Minor_ID is True (see above) 380 381 if OK and then Soft_Minor_ID then 382 Minor_ID := Integer'Value (Line (Start .. Finish)); 383 end if; 384 end if; 385 386 -- If OK is not True, that means the line is not correctly 387 -- formatted. 388 389 if not OK then 390 if not Quiet then 391 Put_Line ("symbol file """ & Reference & 392 """ is incorrectly formatted"); 393 Put_Line ("""" & Line (1 .. Last) & """"); 394 end if; 395 396 Close (File); 397 Success := False; 398 return; 399 end if; 400 end; 401 402 -- Anything else is incorrectly formatted 403 404 else 405 if not Quiet then 406 Put_Line ("unexpected line in symbol file """ & 407 Reference & """"); 408 Put_Line ("""" & Line (1 .. Last) & """"); 409 end if; 410 411 Close (File); 412 Success := False; 413 return; 414 end if; 415 end loop; 416 417 Close (File); 418 end if; 419 end Initialize; 420 421 ------------- 422 -- Process -- 423 ------------- 424 425 procedure Process 426 (Object_File : String; 427 Success : out Boolean) 428 is 429 begin 430 -- Open the object file with Byte_IO. Return with Success = False if 431 -- this fails. 432 433 begin 434 Open (File, In_File, Object_File); 435 exception 436 when others => 437 Put_Line 438 ("*** Unable to open object file """ & Object_File & """"); 439 Success := False; 440 return; 441 end; 442 443 -- Assume that the object file has a correct format 444 445 Success := True; 446 447 -- Get the different sections one by one from the object file 448 449 while not End_Of_File (File) loop 450 451 Get (Code); 452 Get (Number_Of_Characters); 453 Number_Of_Characters := Number_Of_Characters - 4; 454 455 -- If this is not a Global Symbol Definition section, skip to the 456 -- next section. 457 458 if Code /= GSD then 459 460 for J in 1 .. Number_Of_Characters loop 461 Read (File, B); 462 end loop; 463 464 else 465 466 -- Skip over the next 4 bytes 467 468 Get (Dummy); 469 Get (Dummy); 470 Number_Of_Characters := Number_Of_Characters - 4; 471 472 -- Get each subsection in turn 473 474 loop 475 Get (Code); 476 Get (Nchars); 477 Get (Dummy); 478 Get (Flags); 479 Number_Of_Characters := Number_Of_Characters - 8; 480 Nchars := Nchars - 8; 481 482 -- If this is a symbol and the V_DEF flag is set, get the 483 -- symbol. 484 485 if Code = C_SYM and then ((Flags and V_DEF_Mask) /= 0) then 486 -- First, reach the symbol length 487 488 for J in 1 .. 25 loop 489 Read (File, B); 490 Nchars := Nchars - 1; 491 Number_Of_Characters := Number_Of_Characters - 1; 492 end loop; 493 494 Length := Byte'Pos (B); 495 LSymb := 0; 496 497 -- Get the symbol characters 498 499 for J in 1 .. Nchars loop 500 Read (File, B); 501 Number_Of_Characters := Number_Of_Characters - 1; 502 if Length > 0 then 503 LSymb := LSymb + 1; 504 Symbol (LSymb) := B; 505 Length := Length - 1; 506 end if; 507 end loop; 508 509 -- Create the new Symbol 510 511 declare 512 S_Data : Symbol_Data; 513 begin 514 S_Data.Name := new String'(Symbol (1 .. LSymb)); 515 516 -- The symbol kind (Data or Procedure) depends on the 517 -- V_NORM flag. 518 519 if (Flags and V_NORM_Mask) = 0 then 520 S_Data.Kind := Data; 521 522 else 523 S_Data.Kind := Proc; 524 end if; 525 526 -- Put the new symbol in the table 527 528 Symbol_Table.Increment_Last (Complete_Symbols); 529 Complete_Symbols.Table 530 (Symbol_Table.Last (Complete_Symbols)) := S_Data; 531 end; 532 533 else 534 -- As it is not a symbol subsection, skip to the next 535 -- subsection. 536 537 for J in 1 .. Nchars loop 538 Read (File, B); 539 Number_Of_Characters := Number_Of_Characters - 1; 540 end loop; 541 end if; 542 543 -- Exit the GSD section when number of characters reaches 0 544 545 exit when Number_Of_Characters = 0; 546 end loop; 547 end if; 548 end loop; 549 550 -- The object file has been processed, close it 551 552 Close (File); 553 554 exception 555 -- For any exception, output an error message, close the object file 556 -- and return with Success = False. 557 558 when X : others => 559 Put_Line ("unexpected exception raised while processing """ 560 & Object_File & """"); 561 Put_Line (Exception_Information (X)); 562 Close (File); 563 Success := False; 564 end Process; 565 566 -------------- 567 -- Finalize -- 568 -------------- 569 570 procedure Finalize 571 (Quiet : Boolean; 572 Success : out Boolean) 573 is 574 File : Ada.Text_IO.File_Type; 575 -- The symbol file 576 577 S_Data : Symbol_Data; 578 -- A symbol 579 580 Cur : Positive := 1; 581 -- Most probable index in the Complete_Symbols of the current symbol 582 -- in Original_Symbol. 583 584 Found : Boolean; 585 586 begin 587 -- Nothing to be done if Initialize has never been called 588 589 if Symbol_File_Name = null then 590 Success := False; 591 592 else 593 594 -- First find if the symbols in the reference symbol file are also 595 -- in the object files. Note that this is not done if the policy is 596 -- Autonomous, because no reference symbol file has been read. 597 598 -- Expect the first symbol in the symbol file to also be the first 599 -- in Complete_Symbols. 600 601 Cur := 1; 602 603 for Index_1 in 1 .. Symbol_Table.Last (Original_Symbols) loop 604 S_Data := Original_Symbols.Table (Index_1); 605 Found := False; 606 607 First_Object_Loop : 608 for Index_2 in Cur .. Symbol_Table.Last (Complete_Symbols) loop 609 if Equal (S_Data, Complete_Symbols.Table (Index_2)) then 610 Cur := Index_2 + 1; 611 Complete_Symbols.Table (Index_2).Present := False; 612 Found := True; 613 exit First_Object_Loop; 614 end if; 615 end loop First_Object_Loop; 616 617 -- If the symbol could not be found between Cur and Last, try 618 -- before Cur. 619 620 if not Found then 621 Second_Object_Loop : 622 for Index_2 in 1 .. Cur - 1 loop 623 if Equal (S_Data, Complete_Symbols.Table (Index_2)) then 624 Cur := Index_2 + 1; 625 Complete_Symbols.Table (Index_2).Present := False; 626 Found := True; 627 exit Second_Object_Loop; 628 end if; 629 end loop Second_Object_Loop; 630 end if; 631 632 -- If the symbol is not found, mark it as such in the table 633 634 if not Found then 635 if (not Quiet) or else Sym_Policy = Controlled then 636 Put_Line ("symbol """ & S_Data.Name.all & 637 """ is no longer present in the object files"); 638 end if; 639 640 if Sym_Policy = Controlled then 641 Success := False; 642 return; 643 644 elsif Soft_Minor_ID then 645 Minor_ID := Minor_ID + 1; 646 Soft_Minor_ID := False; 647 end if; 648 649 Original_Symbols.Table (Index_1).Present := False; 650 Free (Original_Symbols.Table (Index_1).Name); 651 652 if Soft_Minor_ID then 653 Minor_ID := Minor_ID + 1; 654 Soft_Minor_ID := False; 655 end if; 656 end if; 657 end loop; 658 659 -- Append additional symbols, if any, to the Original_Symbols table 660 661 for Index in 1 .. Symbol_Table.Last (Complete_Symbols) loop 662 S_Data := Complete_Symbols.Table (Index); 663 664 if S_Data.Present then 665 666 if Sym_Policy = Controlled then 667 Put_Line ("symbol """ & S_Data.Name.all & 668 """ is not in the reference symbol file"); 669 Success := False; 670 return; 671 672 elsif Soft_Minor_ID then 673 Minor_ID := Minor_ID + 1; 674 Soft_Minor_ID := False; 675 end if; 676 677 Symbol_Table.Increment_Last (Original_Symbols); 678 Original_Symbols.Table (Symbol_Table.Last (Original_Symbols)) := 679 S_Data; 680 Complete_Symbols.Table (Index).Present := False; 681 end if; 682 end loop; 683 684 -- Create the symbol file 685 686 Create (File, Ada.Text_IO.Out_File, Symbol_File_Name.all); 687 688 Put (File, Case_Sensitive); 689 Put_Line (File, "yes"); 690 691 -- Put a line in the symbol file for each symbol in the symbol table 692 693 for Index in 1 .. Symbol_Table.Last (Original_Symbols) loop 694 if Original_Symbols.Table (Index).Present then 695 Put (File, Symbol_Vector); 696 Put (File, Original_Symbols.Table (Index).Name.all); 697 698 if Original_Symbols.Table (Index).Kind = Data then 699 Put_Line (File, Equal_Data); 700 701 else 702 Put_Line (File, Equal_Procedure); 703 end if; 704 705 Free (Original_Symbols.Table (Index).Name); 706 end if; 707 end loop; 708 709 Put (File, Case_Sensitive); 710 Put_Line (File, "NO"); 711 712 -- Put the version IDs 713 714 Put (File, Gsmatch); 715 Put (File, Image (Major_ID)); 716 Put (File, ','); 717 Put_Line (File, Image (Minor_ID)); 718 719 -- And we are done 720 721 Close (File); 722 723 -- Reset both tables 724 725 Symbol_Table.Set_Last (Original_Symbols, 0); 726 Symbol_Table.Set_Last (Complete_Symbols, 0); 727 728 -- Clear the symbol file name 729 730 Free (Symbol_File_Name); 731 732 Success := True; 733 end if; 734 735 exception 736 when X : others => 737 Put_Line ("unexpected exception raised while finalizing """ 738 & Symbol_File_Name.all & """"); 739 Put_Line (Exception_Information (X)); 740 Success := False; 741 end Finalize; 742 743end Symbols; 744