1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- S E T _ T A R G -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2013-2014, 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 Debug; use Debug; 27with Get_Targ; use Get_Targ; 28with Opt; use Opt; 29with Output; use Output; 30 31with System; use System; 32with System.OS_Lib; use System.OS_Lib; 33 34with Unchecked_Conversion; 35 36package body Set_Targ is 37 38 -------------------------------------------------------- 39 -- Data Used to Read/Write Target Dependent Info File -- 40 -------------------------------------------------------- 41 42 -- Table of string names written to file 43 44 subtype Str is String; 45 46 S_Bits_BE : constant Str := "Bits_BE"; 47 S_Bits_Per_Unit : constant Str := "Bits_Per_Unit"; 48 S_Bits_Per_Word : constant Str := "Bits_Per_Word"; 49 S_Bytes_BE : constant Str := "Bytes_BE"; 50 S_Char_Size : constant Str := "Char_Size"; 51 S_Double_Float_Alignment : constant Str := "Double_Float_Alignment"; 52 S_Double_Scalar_Alignment : constant Str := "Double_Scalar_Alignment"; 53 S_Double_Size : constant Str := "Double_Size"; 54 S_Float_Size : constant Str := "Float_Size"; 55 S_Float_Words_BE : constant Str := "Float_Words_BE"; 56 S_Int_Size : constant Str := "Int_Size"; 57 S_Long_Double_Size : constant Str := "Long_Double_Size"; 58 S_Long_Long_Size : constant Str := "Long_Long_Size"; 59 S_Long_Size : constant Str := "Long_Size"; 60 S_Maximum_Alignment : constant Str := "Maximum_Alignment"; 61 S_Max_Unaligned_Field : constant Str := "Max_Unaligned_Field"; 62 S_Pointer_Size : constant Str := "Pointer_Size"; 63 S_Short_Enums : constant Str := "Short_Enums"; 64 S_Short_Size : constant Str := "Short_Size"; 65 S_Strict_Alignment : constant Str := "Strict_Alignment"; 66 S_System_Allocator_Alignment : constant Str := "System_Allocator_Alignment"; 67 S_Wchar_T_Size : constant Str := "Wchar_T_Size"; 68 S_Words_BE : constant Str := "Words_BE"; 69 70 -- Table of names 71 72 type AStr is access all String; 73 74 DTN : constant array (Nat range <>) of AStr := ( 75 S_Bits_BE 'Unrestricted_Access, 76 S_Bits_Per_Unit 'Unrestricted_Access, 77 S_Bits_Per_Word 'Unrestricted_Access, 78 S_Bytes_BE 'Unrestricted_Access, 79 S_Char_Size 'Unrestricted_Access, 80 S_Double_Float_Alignment 'Unrestricted_Access, 81 S_Double_Scalar_Alignment 'Unrestricted_Access, 82 S_Double_Size 'Unrestricted_Access, 83 S_Float_Size 'Unrestricted_Access, 84 S_Float_Words_BE 'Unrestricted_Access, 85 S_Int_Size 'Unrestricted_Access, 86 S_Long_Double_Size 'Unrestricted_Access, 87 S_Long_Long_Size 'Unrestricted_Access, 88 S_Long_Size 'Unrestricted_Access, 89 S_Maximum_Alignment 'Unrestricted_Access, 90 S_Max_Unaligned_Field 'Unrestricted_Access, 91 S_Pointer_Size 'Unrestricted_Access, 92 S_Short_Enums 'Unrestricted_Access, 93 S_Short_Size 'Unrestricted_Access, 94 S_Strict_Alignment 'Unrestricted_Access, 95 S_System_Allocator_Alignment 'Unrestricted_Access, 96 S_Wchar_T_Size 'Unrestricted_Access, 97 S_Words_BE 'Unrestricted_Access); 98 99 -- Table of corresponding value pointers 100 101 DTV : constant array (Nat range <>) of System.Address := ( 102 Bits_BE 'Address, 103 Bits_Per_Unit 'Address, 104 Bits_Per_Word 'Address, 105 Bytes_BE 'Address, 106 Char_Size 'Address, 107 Double_Float_Alignment 'Address, 108 Double_Scalar_Alignment 'Address, 109 Double_Size 'Address, 110 Float_Size 'Address, 111 Float_Words_BE 'Address, 112 Int_Size 'Address, 113 Long_Double_Size 'Address, 114 Long_Long_Size 'Address, 115 Long_Size 'Address, 116 Maximum_Alignment 'Address, 117 Max_Unaligned_Field 'Address, 118 Pointer_Size 'Address, 119 Short_Enums 'Address, 120 Short_Size 'Address, 121 Strict_Alignment 'Address, 122 System_Allocator_Alignment 'Address, 123 Wchar_T_Size 'Address, 124 Words_BE 'Address); 125 126 DTR : array (Nat range DTV'Range) of Boolean := (others => False); 127 -- Table of flags used to validate that all values are present in file 128 129 ----------------------- 130 -- Local Subprograms -- 131 ----------------------- 132 133 procedure Fail (E : String); 134 pragma No_Return (Fail); 135 -- Terminate program with fatal error message passed as parameter 136 137 procedure Register_Float_Type 138 (Name : C_String; 139 Digs : Natural; 140 Complex : Boolean; 141 Count : Natural; 142 Float_Rep : Float_Rep_Kind; 143 Precision : Positive; 144 Size : Positive; 145 Alignment : Natural); 146 pragma Convention (C, Register_Float_Type); 147 -- Call back to allow the back end to register available types. This call 148 -- back makes entries in the FPT_Mode_Table for any floating point types 149 -- reported by the back end. Name is the name of the type as a normal 150 -- format Null-terminated string. Digs is the number of digits, where 0 151 -- means it is not a fpt type (ignored during registration). Complex is 152 -- non-zero if the type has real and imaginary parts (also ignored during 153 -- registration). Count is the number of elements in a vector type (zero = 154 -- not a vector, registration ignores vectors). Float_Rep shows the kind of 155 -- floating-point type, and Precision, Size and Alignment are the precision 156 -- size and alignment in bits. 157 -- 158 -- So to summarize, the only types that are actually registered have Digs 159 -- non-zero, Complex zero (false), and Count zero (not a vector). 160 161 ---------- 162 -- Fail -- 163 ---------- 164 165 procedure Fail (E : String) is 166 E_Fatal : constant := 4; 167 -- Code for fatal error 168 begin 169 Write_Str (E); 170 Write_Eol; 171 OS_Exit (E_Fatal); 172 end Fail; 173 174 ------------------------- 175 -- Register_Float_Type -- 176 ------------------------- 177 178 procedure Register_Float_Type 179 (Name : C_String; 180 Digs : Natural; 181 Complex : Boolean; 182 Count : Natural; 183 Float_Rep : Float_Rep_Kind; 184 Precision : Positive; 185 Size : Positive; 186 Alignment : Natural) 187 is 188 T : String (1 .. Name'Length); 189 Last : Natural := 0; 190 191 procedure Dump; 192 -- Dump information given by the back end for the type to register 193 194 ---------- 195 -- Dump -- 196 ---------- 197 198 procedure Dump is 199 begin 200 Write_Str ("type " & T (1 .. Last) & " is "); 201 202 if Count > 0 then 203 Write_Str ("array (1 .. "); 204 Write_Int (Int (Count)); 205 206 if Complex then 207 Write_Str (", 1 .. 2"); 208 end if; 209 210 Write_Str (") of "); 211 212 elsif Complex then 213 Write_Str ("array (1 .. 2) of "); 214 end if; 215 216 if Digs > 0 then 217 Write_Str ("digits "); 218 Write_Int (Int (Digs)); 219 Write_Line (";"); 220 221 Write_Str ("pragma Float_Representation ("); 222 223 case Float_Rep is 224 when IEEE_Binary => 225 Write_Str ("IEEE"); 226 227 when VAX_Native => 228 case Digs is 229 when 6 => 230 Write_Str ("VAXF"); 231 232 when 9 => 233 Write_Str ("VAXD"); 234 235 when 15 => 236 Write_Str ("VAXG"); 237 238 when others => 239 Write_Str ("VAX_"); 240 Write_Int (Int (Digs)); 241 end case; 242 243 when AAMP => Write_Str ("AAMP"); 244 end case; 245 246 Write_Line (", " & T (1 .. Last) & ");"); 247 248 else 249 Write_Str ("mod 2**"); 250 Write_Int (Int (Precision / Positive'Max (1, Count))); 251 Write_Line (";"); 252 end if; 253 254 if Precision = Size then 255 Write_Str ("for " & T (1 .. Last) & "'Size use "); 256 Write_Int (Int (Size)); 257 Write_Line (";"); 258 259 else 260 Write_Str ("for " & T (1 .. Last) & "'Value_Size use "); 261 Write_Int (Int (Precision)); 262 Write_Line (";"); 263 264 Write_Str ("for " & T (1 .. Last) & "'Object_Size use "); 265 Write_Int (Int (Size)); 266 Write_Line (";"); 267 end if; 268 269 Write_Str ("for " & T (1 .. Last) & "'Alignment use "); 270 Write_Int (Int (Alignment / 8)); 271 Write_Line (";"); 272 Write_Eol; 273 end Dump; 274 275 -- Start of processing for Register_Float_Type 276 277 begin 278 -- Acquire name 279 280 for J in T'Range loop 281 T (J) := Name (Name'First + J - 1); 282 283 if T (J) = ASCII.NUL then 284 Last := J - 1; 285 exit; 286 end if; 287 end loop; 288 289 -- Dump info if debug flag set 290 291 if Debug_Flag_Dot_B then 292 Dump; 293 end if; 294 295 -- Acquire entry if non-vector non-complex fpt type (digits non-zero) 296 297 if Digs > 0 and then not Complex and then Count = 0 then 298 Num_FPT_Modes := Num_FPT_Modes + 1; 299 FPT_Mode_Table (Num_FPT_Modes) := 300 (NAME => new String'(T (1 .. Last)), 301 DIGS => Digs, 302 FLOAT_REP => Float_Rep, 303 PRECISION => Precision, 304 SIZE => Size, 305 ALIGNMENT => Alignment); 306 end if; 307 end Register_Float_Type; 308 309 ----------------------------------- 310 -- Write_Target_Dependent_Values -- 311 ----------------------------------- 312 313 -- We do this at the System.Os_Lib level, since we have to do the read at 314 -- that level anyway, so it is easier and more consistent to follow the 315 -- same path for the write. 316 317 procedure Write_Target_Dependent_Values is 318 Fdesc : File_Descriptor; 319 OK : Boolean; 320 321 Buffer : String (1 .. 80); 322 Buflen : Natural; 323 -- Buffer used to build line one of file 324 325 type ANat is access all Natural; 326 -- Pointer to Nat or Pos value (it is harmless to treat Pos values and 327 -- Nat values as Natural via Unchecked_Conversion). 328 329 function To_ANat is new Unchecked_Conversion (Address, ANat); 330 331 procedure AddC (C : Character); 332 -- Add one character to buffer 333 334 procedure AddN (N : Natural); 335 -- Add representation of integer N to Buffer, updating Buflen. N 336 -- must be less than 1000, and output is 3 characters with leading 337 -- spaces as needed. 338 339 procedure Write_Line; 340 -- Output contents of Buffer (1 .. Buflen) followed by a New_Line, 341 -- and set Buflen back to zero, ready to write next line. 342 343 ---------- 344 -- AddC -- 345 ---------- 346 347 procedure AddC (C : Character) is 348 begin 349 Buflen := Buflen + 1; 350 Buffer (Buflen) := C; 351 end AddC; 352 353 ---------- 354 -- AddN -- 355 ---------- 356 357 procedure AddN (N : Natural) is 358 begin 359 if N > 999 then 360 raise Program_Error; 361 end if; 362 363 if N > 99 then 364 AddC (Character'Val (48 + N / 100)); 365 else 366 AddC (' '); 367 end if; 368 369 if N > 9 then 370 AddC (Character'Val (48 + N / 10 mod 10)); 371 else 372 AddC (' '); 373 end if; 374 375 AddC (Character'Val (48 + N mod 10)); 376 end AddN; 377 378 ---------------- 379 -- Write_Line -- 380 ---------------- 381 382 procedure Write_Line is 383 begin 384 AddC (ASCII.LF); 385 386 if Buflen /= Write (Fdesc, Buffer'Address, Buflen) then 387 Delete_File (Target_Dependent_Info_Write_Name'Address, OK); 388 Fail ("disk full writing file " 389 & Target_Dependent_Info_Write_Name.all); 390 end if; 391 392 Buflen := 0; 393 end Write_Line; 394 395 -- Start of processing for Write_Target_Dependent_Values 396 397 begin 398 Fdesc := 399 Create_File (Target_Dependent_Info_Write_Name.all'Address, Text); 400 401 if Fdesc = Invalid_FD then 402 Fail ("cannot create file " & Target_Dependent_Info_Write_Name.all); 403 end if; 404 405 -- Loop through values 406 407 for J in DTN'Range loop 408 409 -- Output name 410 411 Buflen := DTN (J)'Length; 412 Buffer (1 .. Buflen) := DTN (J).all; 413 414 -- Line up values 415 416 while Buflen < 26 loop 417 AddC (' '); 418 end loop; 419 420 AddC (' '); 421 AddC (' '); 422 423 -- Output value and write line 424 425 AddN (To_ANat (DTV (J)).all); 426 Write_Line; 427 end loop; 428 429 -- Blank line to separate sections 430 431 Write_Line; 432 433 -- Write lines for registered FPT types 434 435 for J in 1 .. Num_FPT_Modes loop 436 declare 437 E : FPT_Mode_Entry renames FPT_Mode_Table (J); 438 begin 439 Buflen := E.NAME'Last; 440 Buffer (1 .. Buflen) := E.NAME.all; 441 442 -- Pad out to line up values 443 444 while Buflen < 11 loop 445 AddC (' '); 446 end loop; 447 448 AddC (' '); 449 AddC (' '); 450 451 AddN (E.DIGS); 452 AddC (' '); 453 AddC (' '); 454 455 case E.FLOAT_REP is 456 when IEEE_Binary => 457 AddC ('I'); 458 when VAX_Native => 459 AddC ('V'); 460 when AAMP => 461 AddC ('A'); 462 end case; 463 464 AddC (' '); 465 466 AddN (E.PRECISION); 467 AddC (' '); 468 469 AddN (E.ALIGNMENT); 470 Write_Line; 471 end; 472 end loop; 473 474 -- Close file 475 476 Close (Fdesc, OK); 477 478 if not OK then 479 Fail ("disk full writing file " 480 & Target_Dependent_Info_Write_Name.all); 481 end if; 482 end Write_Target_Dependent_Values; 483 484-- Package Initialization, set target dependent values. This must be done 485-- early on, before we start accessing various compiler packages, since 486-- these values are used all over the place. 487 488begin 489 -- First step: see if the -gnateT switch is present. As we have noted, 490 -- this has to be done very early, so can not depend on the normal circuit 491 -- for reading switches and setting switches in Opt. The following code 492 -- will set Opt.Target_Dependent_Info_Read_Name if the switch -gnateT=name 493 -- is present in the options string. 494 495 declare 496 type Arg_Array is array (Nat) of Big_String_Ptr; 497 type Arg_Array_Ptr is access Arg_Array; 498 -- Types to access compiler arguments 499 500 save_argc : Nat; 501 pragma Import (C, save_argc); 502 -- Saved value of argc (number of arguments), imported from misc.c 503 504 save_argv : Arg_Array_Ptr; 505 pragma Import (C, save_argv); 506 -- Saved value of argv (argument pointers), imported from misc.c 507 508 gnat_argc : Nat; 509 gnat_argv : Arg_Array_Ptr; 510 pragma Import (C, gnat_argc); 511 pragma Import (C, gnat_argv); 512 -- If save_argv is not set, default to gnat_argc/argv 513 514 argc : Nat; 515 argv : Arg_Array_Ptr; 516 517 function Len_Arg (Arg : Big_String_Ptr) return Nat; 518 -- Determine length of argument Arg (a nul terminated C string). 519 520 ------------- 521 -- Len_Arg -- 522 ------------- 523 524 function Len_Arg (Arg : Big_String_Ptr) return Nat is 525 begin 526 for J in 1 .. Nat'Last loop 527 if Arg (Natural (J)) = ASCII.NUL then 528 return J - 1; 529 end if; 530 end loop; 531 532 raise Program_Error; 533 end Len_Arg; 534 535 begin 536 if save_argv /= null then 537 argv := save_argv; 538 argc := save_argc; 539 else 540 -- Case of a non gcc compiler, e.g. gnat2why or gnat2scil 541 argv := gnat_argv; 542 argc := gnat_argc; 543 end if; 544 545 -- Loop through arguments looking for -gnateT, also look for -gnatd.b 546 547 for Arg in 1 .. argc - 1 loop 548 declare 549 Argv_Ptr : constant Big_String_Ptr := argv (Arg); 550 Argv_Len : constant Nat := Len_Arg (Argv_Ptr); 551 552 begin 553 if Argv_Len > 8 554 and then Argv_Ptr (1 .. 8) = "-gnateT=" 555 then 556 Opt.Target_Dependent_Info_Read_Name := 557 new String'(Argv_Ptr (9 .. Natural (Argv_Len))); 558 559 elsif Argv_Len >= 8 560 and then Argv_Ptr (1 .. 8) = "-gnatd.b" 561 then 562 Debug_Flag_Dot_B := True; 563 end if; 564 end; 565 end loop; 566 end; 567 568 -- If the switch is not set, we get all values from the back end 569 570 if Opt.Target_Dependent_Info_Read_Name = null then 571 572 -- Set values by direct calls to the back end 573 574 Bits_BE := Get_Bits_BE; 575 Bits_Per_Unit := Get_Bits_Per_Unit; 576 Bits_Per_Word := Get_Bits_Per_Word; 577 Bytes_BE := Get_Bytes_BE; 578 Char_Size := Get_Char_Size; 579 Double_Float_Alignment := Get_Double_Float_Alignment; 580 Double_Scalar_Alignment := Get_Double_Scalar_Alignment; 581 Double_Size := Get_Double_Size; 582 Float_Size := Get_Float_Size; 583 Float_Words_BE := Get_Float_Words_BE; 584 Int_Size := Get_Int_Size; 585 Long_Double_Size := Get_Long_Double_Size; 586 Long_Long_Size := Get_Long_Long_Size; 587 Long_Size := Get_Long_Size; 588 Maximum_Alignment := Get_Maximum_Alignment; 589 Max_Unaligned_Field := Get_Max_Unaligned_Field; 590 Pointer_Size := Get_Pointer_Size; 591 Short_Enums := Get_Short_Enums; 592 Short_Size := Get_Short_Size; 593 Strict_Alignment := Get_Strict_Alignment; 594 System_Allocator_Alignment := Get_System_Allocator_Alignment; 595 Wchar_T_Size := Get_Wchar_T_Size; 596 Words_BE := Get_Words_BE; 597 598 -- Register floating-point types from the back end 599 600 Register_Back_End_Types (Register_Float_Type'Access); 601 602 -- Case of reading the target dependent values from file 603 604 -- This is bit more complex than might be expected, because it has to be 605 -- done very early. All kinds of packages depend on these values, and we 606 -- can't wait till the normal processing of reading command line switches 607 -- etc to read the file. We do this at the System.OS_Lib level since it is 608 -- too early to be using Osint directly. 609 610 else 611 Read_Target_Dependent_Values : declare 612 File_Desc : File_Descriptor; 613 N : Natural; 614 615 type ANat is access all Natural; 616 -- Pointer to Nat or Pos value (it is harmless to treat Pos values 617 -- as Nat via Unchecked_Conversion). 618 619 function To_ANat is new Unchecked_Conversion (Address, ANat); 620 621 VP : ANat; 622 623 Buffer : String (1 .. 2000); 624 Buflen : Natural; 625 -- File information and length (2000 easily enough) 626 627 Nam_Buf : String (1 .. 40); 628 Nam_Len : Natural; 629 630 procedure Check_Spaces; 631 -- Checks that we have one or more spaces and skips them 632 633 procedure FailN (S : String); 634 -- Calls Fail adding " name in file xxx", where name is the currently 635 -- gathered name in Nam_Buf, surrounded by quotes, and xxx is the 636 -- name of the file. 637 638 procedure Get_Name; 639 -- Scan out name, leaving it in Nam_Buf with Nam_Len set. Calls 640 -- Skip_Spaces to skip any following spaces. Note that the name is 641 -- terminated by a sequence of at least two spaces. 642 643 function Get_Nat return Natural; 644 -- N on entry points to decimal integer, scan out decimal integer 645 -- and return it, leaving N pointing to following space or LF. 646 647 procedure Skip_Spaces; 648 -- Skip past spaces 649 650 ------------------ 651 -- Check_Spaces -- 652 ------------------ 653 654 procedure Check_Spaces is 655 begin 656 if N > Buflen or else Buffer (N) /= ' ' then 657 FailN ("missing space for"); 658 end if; 659 660 Skip_Spaces; 661 return; 662 end Check_Spaces; 663 664 ----------- 665 -- FailN -- 666 ----------- 667 668 procedure FailN (S : String) is 669 begin 670 Fail (S & " """ & Nam_Buf (1 .. Nam_Len) & """ in file " 671 & Target_Dependent_Info_Read_Name.all); 672 end FailN; 673 674 -------------- 675 -- Get_Name -- 676 -------------- 677 678 procedure Get_Name is 679 begin 680 Nam_Len := 0; 681 682 -- Scan out name and put it in Nam_Buf 683 684 loop 685 if N > Buflen or else Buffer (N) = ASCII.LF then 686 FailN ("incorrectly formatted line for"); 687 end if; 688 689 -- Name is terminated by two blanks 690 691 exit when N < Buflen and then Buffer (N .. N + 1) = " "; 692 693 Nam_Len := Nam_Len + 1; 694 695 if Nam_Len > Nam_Buf'Last then 696 Fail ("name too long"); 697 end if; 698 699 Nam_Buf (Nam_Len) := Buffer (N); 700 N := N + 1; 701 end loop; 702 703 Check_Spaces; 704 end Get_Name; 705 706 ------------- 707 -- Get_Nat -- 708 ------------- 709 710 function Get_Nat return Natural is 711 Result : Natural := 0; 712 713 begin 714 loop 715 if N > Buflen 716 or else Buffer (N) not in '0' .. '9' 717 or else Result > 999 718 then 719 FailN ("bad value for"); 720 end if; 721 722 Result := Result * 10 + (Character'Pos (Buffer (N)) - 48); 723 N := N + 1; 724 725 exit when N <= Buflen 726 and then (Buffer (N) = ASCII.LF or else Buffer (N) = ' '); 727 end loop; 728 729 return Result; 730 end Get_Nat; 731 732 ----------------- 733 -- Skip_Spaces -- 734 ----------------- 735 736 procedure Skip_Spaces is 737 begin 738 while N <= Buflen and Buffer (N) = ' ' loop 739 N := N + 1; 740 end loop; 741 end Skip_Spaces; 742 743 -- Start of processing for Read_Target_Dependent_Values 744 745 begin 746 File_Desc := Open_Read (Target_Dependent_Info_Read_Name.all, Text); 747 748 if File_Desc = Invalid_FD then 749 Fail ("cannot read file " & Target_Dependent_Info_Read_Name.all); 750 end if; 751 752 Buflen := Read (File_Desc, Buffer'Address, Buffer'Length); 753 754 if Buflen = Buffer'Length then 755 Fail ("file is too long: " & Target_Dependent_Info_Read_Name.all); 756 end if; 757 758 -- Scan through file for properly formatted entries in first section 759 760 N := 1; 761 while N <= Buflen and then Buffer (N) /= ASCII.LF loop 762 Get_Name; 763 764 -- Validate name and get corresponding value pointer 765 766 VP := null; 767 768 for J in DTN'Range loop 769 if DTN (J).all = Nam_Buf (1 .. Nam_Len) then 770 VP := To_ANat (DTV (J)); 771 DTR (J) := True; 772 exit; 773 end if; 774 end loop; 775 776 if VP = null then 777 FailN ("unrecognized name"); 778 end if; 779 780 -- Scan out value 781 782 VP.all := Get_Nat; 783 784 if N > Buflen or else Buffer (N) /= ASCII.LF then 785 FailN ("misformatted line for"); 786 end if; 787 788 N := N + 1; -- skip LF 789 end loop; 790 791 -- Fall through this loop when all lines in first section read. 792 -- Check that values have been supplied for all entries. 793 794 for J in DTR'Range loop 795 if not DTR (J) then 796 Fail ("missing entry for " & DTN (J).all & " in file " 797 & Target_Dependent_Info_Read_Name.all); 798 end if; 799 end loop; 800 801 -- Now acquire FPT entries 802 803 if N >= Buflen then 804 Fail ("missing entries for FPT modes in file " 805 & Target_Dependent_Info_Read_Name.all); 806 end if; 807 808 if Buffer (N) = ASCII.LF then 809 N := N + 1; 810 else 811 Fail ("missing blank line in file " 812 & Target_Dependent_Info_Read_Name.all); 813 end if; 814 815 Num_FPT_Modes := 0; 816 while N <= Buflen loop 817 Get_Name; 818 819 Num_FPT_Modes := Num_FPT_Modes + 1; 820 821 declare 822 E : FPT_Mode_Entry renames FPT_Mode_Table (Num_FPT_Modes); 823 824 begin 825 E.NAME := new String'(Nam_Buf (1 .. Nam_Len)); 826 827 E.DIGS := Get_Nat; 828 Check_Spaces; 829 830 case Buffer (N) is 831 when 'I' => 832 E.FLOAT_REP := IEEE_Binary; 833 when 'V' => 834 E.FLOAT_REP := VAX_Native; 835 when 'A' => 836 E.FLOAT_REP := AAMP; 837 when others => 838 FailN ("bad float rep field for"); 839 end case; 840 841 N := N + 1; 842 Check_Spaces; 843 844 E.PRECISION := Get_Nat; 845 Check_Spaces; 846 847 E.ALIGNMENT := Get_Nat; 848 849 if Buffer (N) /= ASCII.LF then 850 FailN ("junk at end of line for"); 851 end if; 852 853 -- ??? We do not read E.SIZE, see Write_Target_Dependent_Values 854 855 E.SIZE := 856 (E.PRECISION + E.ALIGNMENT - 1) / E.ALIGNMENT * E.ALIGNMENT; 857 858 N := N + 1; 859 end; 860 end loop; 861 end Read_Target_Dependent_Values; 862 end if; 863end Set_Targ; 864