File : set_targ.adb


   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-2016, 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 with Debug;    use Debug;
  27 with Get_Targ; use Get_Targ;
  28 with Opt;      use Opt;
  29 with Output;   use Output;
  30 
  31 with System;        use System;
  32 with System.OS_Lib; use System.OS_Lib;
  33 
  34 with Unchecked_Conversion;
  35 
  36 package 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 Read_Target_Dependent_Values (File_Name : String);
 134    --  Read target dependent values from File_Name, and set the target
 135    --  dependent values (global variables) declared in this package.
 136 
 137    procedure Fail (E : String);
 138    pragma No_Return (Fail);
 139    --  Terminate program with fatal error message passed as parameter
 140 
 141    procedure Register_Float_Type
 142      (Name      : C_String;
 143       Digs      : Natural;
 144       Complex   : Boolean;
 145       Count     : Natural;
 146       Float_Rep : Float_Rep_Kind;
 147       Precision : Positive;
 148       Size      : Positive;
 149       Alignment : Natural);
 150    pragma Convention (C, Register_Float_Type);
 151    --  Call back to allow the back end to register available types. This call
 152    --  back makes entries in the FPT_Mode_Table for any floating point types
 153    --  reported by the back end. Name is the name of the type as a normal
 154    --  format Null-terminated string. Digs is the number of digits, where 0
 155    --  means it is not a fpt type (ignored during registration). Complex is
 156    --  non-zero if the type has real and imaginary parts (also ignored during
 157    --  registration). Count is the number of elements in a vector type (zero =
 158    --  not a vector, registration ignores vectors). Float_Rep shows the kind of
 159    --  floating-point type, and Precision, Size and Alignment are the precision
 160    --  size and alignment in bits.
 161    --
 162    --  The only types that are actually registered have Digs non-zero, Complex
 163    --  zero (false), and Count zero (not a vector). The Long_Double_Index
 164    --  variable below is updated to indicate the index at which a "long double"
 165    --  type can be found if it gets registered at all.
 166 
 167    Long_Double_Index : Integer := -1;
 168    --  Once all the floating point types have been registered, the index in
 169    --  FPT_Mode_Table at which "long double" can be found, if anywhere. A
 170    --  negative value means that no "long double" has been registered. This
 171    --  is useful to know whether we have a "long double" available at all and
 172    --  get at it's characteristics without having to search the FPT_Mode_Table
 173    --  when we need to decide which C type should be used as the basis for
 174    --  Long_Long_Float in Ada.
 175 
 176    function FPT_Mode_Index_For (Name : String) return Natural;
 177    --  Return the index in FPT_Mode_Table that designates the entry
 178    --  corresponding to the C type named Name. Raise Program_Error if
 179    --  there is no such entry.
 180 
 181    function FPT_Mode_Index_For (T : S_Float_Types) return Natural;
 182    --  Return the index in FPT_Mode_Table that designates the entry for
 183    --  a back-end type suitable as a basis to construct the standard Ada
 184    --  floating point type identified by T.
 185 
 186    ----------------
 187    -- C_Type_For --
 188    ----------------
 189 
 190    function C_Type_For (T : S_Float_Types) return String is
 191 
 192       --  ??? For now, we don't have a good way to tell the widest float
 193       --  type with hardware support. Basically, GCC knows the size of that
 194       --  type, but on x86-64 there often are two or three 128-bit types,
 195       --  one double extended that has 18 decimal digits, a 128-bit quad
 196       --  precision type with 33 digits and possibly a 128-bit decimal float
 197       --  type with 34 digits. As a workaround, we define Long_Long_Float as
 198       --  C's "long double" if that type exists and has at most 18 digits,
 199       --  or otherwise the same as Long_Float.
 200 
 201       Max_HW_Digs : constant := 18;
 202       --  Maximum hardware digits supported
 203 
 204    begin
 205       case T is
 206          when S_Short_Float | S_Float =>
 207             return "float";
 208          when S_Long_Float =>
 209             return "double";
 210          when S_Long_Long_Float =>
 211             if Long_Double_Index >= 0
 212               and then FPT_Mode_Table (Long_Double_Index).DIGS <= Max_HW_Digs
 213             then
 214                return "long double";
 215             else
 216                return "double";
 217             end if;
 218       end case;
 219    end C_Type_For;
 220 
 221    ----------
 222    -- Fail --
 223    ----------
 224 
 225    procedure Fail (E : String) is
 226       E_Fatal : constant := 4;
 227       --  Code for fatal error
 228 
 229    begin
 230       Write_Str (E);
 231       Write_Eol;
 232       OS_Exit (E_Fatal);
 233    end Fail;
 234 
 235    ------------------------
 236    -- FPT_Mode_Index_For --
 237    ------------------------
 238 
 239    function FPT_Mode_Index_For (Name : String) return Natural is
 240    begin
 241       for J in FPT_Mode_Table'First .. Num_FPT_Modes loop
 242          if FPT_Mode_Table (J).NAME.all = Name then
 243             return J;
 244          end if;
 245       end loop;
 246 
 247       raise Program_Error;
 248    end FPT_Mode_Index_For;
 249 
 250    function FPT_Mode_Index_For (T : S_Float_Types) return Natural is
 251    begin
 252       return FPT_Mode_Index_For (C_Type_For (T));
 253    end FPT_Mode_Index_For;
 254 
 255    -------------------------
 256    -- Register_Float_Type --
 257    -------------------------
 258 
 259    procedure Register_Float_Type
 260      (Name      : C_String;
 261       Digs      : Natural;
 262       Complex   : Boolean;
 263       Count     : Natural;
 264       Float_Rep : Float_Rep_Kind;
 265       Precision : Positive;
 266       Size      : Positive;
 267       Alignment : Natural)
 268    is
 269       T    : String (1 .. Name'Length);
 270       Last : Natural := 0;
 271 
 272       procedure Dump;
 273       --  Dump information given by the back end for the type to register
 274 
 275       ----------
 276       -- Dump --
 277       ----------
 278 
 279       procedure Dump is
 280       begin
 281          Write_Str ("type " & T (1 .. Last) & " is ");
 282 
 283          if Count > 0 then
 284             Write_Str ("array (1 .. ");
 285             Write_Int (Int (Count));
 286 
 287             if Complex then
 288                Write_Str (", 1 .. 2");
 289             end if;
 290 
 291             Write_Str (") of ");
 292 
 293          elsif Complex then
 294             Write_Str ("array (1 .. 2) of ");
 295          end if;
 296 
 297          if Digs > 0 then
 298             Write_Str ("digits ");
 299             Write_Int (Int (Digs));
 300             Write_Line (";");
 301 
 302             Write_Str ("pragma Float_Representation (");
 303 
 304             case Float_Rep is
 305                when IEEE_Binary => Write_Str ("IEEE");
 306                when AAMP        => Write_Str ("AAMP");
 307             end case;
 308 
 309             Write_Line (", " & T (1 .. Last) & ");");
 310 
 311          else
 312             Write_Str ("mod 2**");
 313             Write_Int (Int (Precision / Positive'Max (1, Count)));
 314             Write_Line (";");
 315          end if;
 316 
 317          if Precision = Size then
 318             Write_Str ("for " & T (1 .. Last) & "'Size use ");
 319             Write_Int (Int (Size));
 320             Write_Line (";");
 321 
 322          else
 323             Write_Str ("for " & T (1 .. Last) & "'Value_Size use ");
 324             Write_Int (Int (Precision));
 325             Write_Line (";");
 326 
 327             Write_Str ("for " & T (1 .. Last) & "'Object_Size use ");
 328             Write_Int (Int (Size));
 329             Write_Line (";");
 330          end if;
 331 
 332          Write_Str ("for " & T (1 .. Last) & "'Alignment use ");
 333          Write_Int (Int (Alignment / 8));
 334          Write_Line (";");
 335          Write_Eol;
 336       end Dump;
 337 
 338    --  Start of processing for Register_Float_Type
 339 
 340    begin
 341       --  Acquire name
 342 
 343       for J in T'Range loop
 344          T (J) := Name (Name'First + J - 1);
 345 
 346          if T (J) = ASCII.NUL then
 347             Last := J - 1;
 348             exit;
 349          end if;
 350       end loop;
 351 
 352       --  Dump info if debug flag set
 353 
 354       if Debug_Flag_Dot_B then
 355          Dump;
 356       end if;
 357 
 358       --  Acquire entry if non-vector non-complex fpt type (digits non-zero)
 359 
 360       if Digs > 0 and then not Complex and then Count = 0 then
 361 
 362          declare
 363             This_Name : constant String := T (1 .. Last);
 364          begin
 365             Num_FPT_Modes := Num_FPT_Modes + 1;
 366             FPT_Mode_Table (Num_FPT_Modes) :=
 367               (NAME      => new String'(This_Name),
 368                DIGS      => Digs,
 369                FLOAT_REP => Float_Rep,
 370                PRECISION => Precision,
 371                SIZE      => Size,
 372                ALIGNMENT => Alignment);
 373 
 374             if Long_Double_Index < 0 and then This_Name = "long double" then
 375                Long_Double_Index := Num_FPT_Modes;
 376             end if;
 377          end;
 378       end if;
 379    end Register_Float_Type;
 380 
 381    -----------------------------------
 382    -- Write_Target_Dependent_Values --
 383    -----------------------------------
 384 
 385    --  We do this at the System.Os_Lib level, since we have to do the read at
 386    --  that level anyway, so it is easier and more consistent to follow the
 387    --  same path for the write.
 388 
 389    procedure Write_Target_Dependent_Values is
 390       Fdesc  : File_Descriptor;
 391       OK     : Boolean;
 392 
 393       Buffer : String (1 .. 80);
 394       Buflen : Natural;
 395       --  Buffer used to build line one of file
 396 
 397       type ANat is access all Natural;
 398       --  Pointer to Nat or Pos value (it is harmless to treat Pos values and
 399       --  Nat values as Natural via Unchecked_Conversion).
 400 
 401       function To_ANat is new Unchecked_Conversion (Address, ANat);
 402 
 403       procedure AddC (C : Character);
 404       --  Add one character to buffer
 405 
 406       procedure AddN (N : Natural);
 407       --  Add representation of integer N to Buffer, updating Buflen. N
 408       --  must be less than 1000, and output is 3 characters with leading
 409       --  spaces as needed.
 410 
 411       procedure Write_Line;
 412       --  Output contents of Buffer (1 .. Buflen) followed by a New_Line,
 413       --  and set Buflen back to zero, ready to write next line.
 414 
 415       ----------
 416       -- AddC --
 417       ----------
 418 
 419       procedure AddC (C : Character) is
 420       begin
 421          Buflen := Buflen + 1;
 422          Buffer (Buflen) := C;
 423       end AddC;
 424 
 425       ----------
 426       -- AddN --
 427       ----------
 428 
 429       procedure AddN (N : Natural) is
 430       begin
 431          if N > 999 then
 432             raise Program_Error;
 433          end if;
 434 
 435          if N > 99 then
 436             AddC (Character'Val (48 + N / 100));
 437          else
 438             AddC (' ');
 439          end if;
 440 
 441          if N > 9 then
 442             AddC (Character'Val (48 + N / 10 mod 10));
 443          else
 444             AddC (' ');
 445          end if;
 446 
 447          AddC (Character'Val (48 + N mod 10));
 448       end AddN;
 449 
 450       ----------------
 451       -- Write_Line --
 452       ----------------
 453 
 454       procedure Write_Line is
 455       begin
 456          AddC (ASCII.LF);
 457 
 458          if Buflen /= Write (Fdesc, Buffer'Address, Buflen) then
 459             Delete_File (Target_Dependent_Info_Write_Name.all, OK);
 460             Fail ("disk full writing file "
 461                   & Target_Dependent_Info_Write_Name.all);
 462          end if;
 463 
 464          Buflen := 0;
 465       end Write_Line;
 466 
 467    --  Start of processing for Write_Target_Dependent_Values
 468 
 469    begin
 470       Fdesc :=
 471         Create_File (Target_Dependent_Info_Write_Name.all, Text);
 472 
 473       if Fdesc = Invalid_FD then
 474          Fail ("cannot create file " & Target_Dependent_Info_Write_Name.all);
 475       end if;
 476 
 477       --  Loop through values
 478 
 479       for J in DTN'Range loop
 480 
 481          --  Output name
 482 
 483          Buflen := DTN (J)'Length;
 484          Buffer (1 .. Buflen) := DTN (J).all;
 485 
 486          --  Line up values
 487 
 488          while Buflen < 26 loop
 489             AddC (' ');
 490          end loop;
 491 
 492          AddC (' ');
 493          AddC (' ');
 494 
 495          --  Output value and write line
 496 
 497          AddN (To_ANat (DTV (J)).all);
 498          Write_Line;
 499       end loop;
 500 
 501       --  Blank line to separate sections
 502 
 503       Write_Line;
 504 
 505       --  Write lines for registered FPT types
 506 
 507       for J in 1 .. Num_FPT_Modes loop
 508          declare
 509             E : FPT_Mode_Entry renames FPT_Mode_Table (J);
 510          begin
 511             Buflen := E.NAME'Last;
 512             Buffer (1 .. Buflen) := E.NAME.all;
 513 
 514             --  Pad out to line up values
 515 
 516             while Buflen < 11 loop
 517                AddC (' ');
 518             end loop;
 519 
 520             AddC (' ');
 521             AddC (' ');
 522 
 523             AddN (E.DIGS);
 524             AddC (' ');
 525             AddC (' ');
 526 
 527             case E.FLOAT_REP is
 528                when IEEE_Binary =>
 529                   AddC ('I');
 530                when AAMP        =>
 531                   AddC ('A');
 532             end case;
 533 
 534             AddC (' ');
 535 
 536             AddN (E.PRECISION);
 537             AddC (' ');
 538 
 539             AddN (E.ALIGNMENT);
 540             Write_Line;
 541          end;
 542       end loop;
 543 
 544       --  Close file
 545 
 546       Close (Fdesc, OK);
 547 
 548       if not OK then
 549          Fail ("disk full writing file "
 550                & Target_Dependent_Info_Write_Name.all);
 551       end if;
 552    end Write_Target_Dependent_Values;
 553 
 554    ----------------------------------
 555    -- Read_Target_Dependent_Values --
 556    ----------------------------------
 557 
 558    procedure Read_Target_Dependent_Values (File_Name : String) is
 559       File_Desc : File_Descriptor;
 560       N         : Natural;
 561 
 562       type ANat is access all Natural;
 563       --  Pointer to Nat or Pos value (it is harmless to treat Pos values
 564       --  as Nat via Unchecked_Conversion).
 565 
 566       function To_ANat is new Unchecked_Conversion (Address, ANat);
 567 
 568       VP : ANat;
 569 
 570       Buffer : String (1 .. 2000);
 571       Buflen : Natural;
 572       --  File information and length (2000 easily enough)
 573 
 574       Nam_Buf : String (1 .. 40);
 575       Nam_Len : Natural;
 576 
 577       procedure Check_Spaces;
 578       --  Checks that we have one or more spaces and skips them
 579 
 580       procedure FailN (S : String);
 581       --  Calls Fail adding " name in file xxx", where name is the currently
 582       --  gathered name in Nam_Buf, surrounded by quotes, and xxx is the
 583       --  name of the file.
 584 
 585       procedure Get_Name;
 586       --  Scan out name, leaving it in Nam_Buf with Nam_Len set. Calls
 587       --  Skip_Spaces to skip any following spaces. Note that the name is
 588       --  terminated by a sequence of at least two spaces.
 589 
 590       function Get_Nat return Natural;
 591       --  N on entry points to decimal integer, scan out decimal integer
 592       --  and return it, leaving N pointing to following space or LF.
 593 
 594       procedure Skip_Spaces;
 595       --  Skip past spaces
 596 
 597       ------------------
 598       -- Check_Spaces --
 599       ------------------
 600 
 601       procedure Check_Spaces is
 602       begin
 603          if N > Buflen or else Buffer (N) /= ' ' then
 604             FailN ("missing space for");
 605          end if;
 606 
 607          Skip_Spaces;
 608          return;
 609       end Check_Spaces;
 610 
 611       -----------
 612       -- FailN --
 613       -----------
 614 
 615       procedure FailN (S : String) is
 616       begin
 617          Fail (S & " """ & Nam_Buf (1 .. Nam_Len) & """ in file "
 618                & File_Name);
 619       end FailN;
 620 
 621       --------------
 622       -- Get_Name --
 623       --------------
 624 
 625       procedure Get_Name is
 626       begin
 627          Nam_Len := 0;
 628 
 629          --  Scan out name and put it in Nam_Buf
 630 
 631          loop
 632             if N > Buflen or else Buffer (N) = ASCII.LF then
 633                FailN ("incorrectly formatted line for");
 634             end if;
 635 
 636             --  Name is terminated by two blanks
 637 
 638             exit when N < Buflen and then Buffer (N .. N + 1) = "  ";
 639 
 640             Nam_Len := Nam_Len + 1;
 641 
 642             if Nam_Len > Nam_Buf'Last then
 643                Fail ("name too long");
 644             end if;
 645 
 646             Nam_Buf (Nam_Len) := Buffer (N);
 647             N := N + 1;
 648          end loop;
 649 
 650          Check_Spaces;
 651       end Get_Name;
 652 
 653       -------------
 654       -- Get_Nat --
 655       -------------
 656 
 657       function Get_Nat return Natural is
 658          Result : Natural := 0;
 659 
 660       begin
 661          loop
 662             if N > Buflen
 663               or else Buffer (N) not in '0' .. '9'
 664               or else Result > 999
 665             then
 666                FailN ("bad value for");
 667             end if;
 668 
 669             Result := Result * 10 + (Character'Pos (Buffer (N)) - 48);
 670             N := N + 1;
 671 
 672             exit when N <= Buflen
 673               and then (Buffer (N) = ASCII.LF or else Buffer (N) = ' ');
 674          end loop;
 675 
 676          return Result;
 677       end Get_Nat;
 678 
 679       -----------------
 680       -- Skip_Spaces --
 681       -----------------
 682 
 683       procedure Skip_Spaces is
 684       begin
 685          while N <= Buflen and Buffer (N) = ' ' loop
 686             N := N + 1;
 687          end loop;
 688       end Skip_Spaces;
 689 
 690    --  Start of processing for Read_Target_Dependent_Values
 691 
 692    begin
 693       File_Desc := Open_Read (File_Name, Text);
 694 
 695       if File_Desc = Invalid_FD then
 696          Fail ("cannot read file " & File_Name);
 697       end if;
 698 
 699       Buflen := Read (File_Desc, Buffer'Address, Buffer'Length);
 700 
 701       Close (File_Desc);
 702 
 703       if Buflen = Buffer'Length then
 704          Fail ("file is too long: " & File_Name);
 705       end if;
 706 
 707       --  Scan through file for properly formatted entries in first section
 708 
 709       N := 1;
 710       while N <= Buflen and then Buffer (N) /= ASCII.LF loop
 711          Get_Name;
 712 
 713          --  Validate name and get corresponding value pointer
 714 
 715          VP := null;
 716 
 717          for J in DTN'Range loop
 718             if DTN (J).all = Nam_Buf (1 .. Nam_Len) then
 719                VP := To_ANat (DTV (J));
 720                DTR (J) := True;
 721                exit;
 722             end if;
 723          end loop;
 724 
 725          if VP = null then
 726             FailN ("unrecognized name");
 727          end if;
 728 
 729          --  Scan out value
 730 
 731          VP.all := Get_Nat;
 732 
 733          if N > Buflen or else Buffer (N) /= ASCII.LF then
 734             FailN ("misformatted line for");
 735          end if;
 736 
 737          N := N + 1; -- skip LF
 738       end loop;
 739 
 740       --  Fall through this loop when all lines in first section read.
 741       --  Check that values have been supplied for all entries.
 742 
 743       for J in DTR'Range loop
 744          if not DTR (J) then
 745             Fail ("missing entry for " & DTN (J).all & " in file "
 746                   & File_Name);
 747          end if;
 748       end loop;
 749 
 750       --  Now acquire FPT entries
 751 
 752       if N >= Buflen then
 753          Fail ("missing entries for FPT modes in file " & File_Name);
 754       end if;
 755 
 756       if Buffer (N) = ASCII.LF then
 757          N := N + 1;
 758       else
 759          Fail ("missing blank line in file " & File_Name);
 760       end if;
 761 
 762       Num_FPT_Modes := 0;
 763       while N <= Buflen loop
 764          Get_Name;
 765 
 766          Num_FPT_Modes := Num_FPT_Modes + 1;
 767 
 768          declare
 769             E : FPT_Mode_Entry renames FPT_Mode_Table (Num_FPT_Modes);
 770 
 771          begin
 772             E.NAME := new String'(Nam_Buf (1 .. Nam_Len));
 773 
 774             if Long_Double_Index < 0 and then E.NAME.all = "long double" then
 775                Long_Double_Index := Num_FPT_Modes;
 776             end if;
 777 
 778             E.DIGS := Get_Nat;
 779             Check_Spaces;
 780 
 781             case Buffer (N) is
 782                when 'I'    =>
 783                   E.FLOAT_REP := IEEE_Binary;
 784                when 'A'    =>
 785                   E.FLOAT_REP := AAMP;
 786                when others =>
 787                   FailN ("bad float rep field for");
 788             end case;
 789 
 790             N := N + 1;
 791             Check_Spaces;
 792 
 793             E.PRECISION := Get_Nat;
 794             Check_Spaces;
 795 
 796             E.ALIGNMENT := Get_Nat;
 797 
 798             if Buffer (N) /= ASCII.LF then
 799                FailN ("junk at end of line for");
 800             end if;
 801 
 802             --  ??? We do not read E.SIZE, see Write_Target_Dependent_Values
 803 
 804             E.SIZE :=
 805               (E.PRECISION + E.ALIGNMENT - 1) / E.ALIGNMENT * E.ALIGNMENT;
 806 
 807             N := N + 1;
 808          end;
 809       end loop;
 810    end Read_Target_Dependent_Values;
 811 
 812 --  Package Initialization, set target dependent values. This must be done
 813 --  early on, before we start accessing various compiler packages, since
 814 --  these values are used all over the place.
 815 
 816 begin
 817    --  First step: see if the -gnateT switch is present. As we have noted,
 818    --  this has to be done very early, so can not depend on the normal circuit
 819    --  for reading switches and setting switches in Opt. The following code
 820    --  will set Opt.Target_Dependent_Info_Read_Name if the switch -gnateT=name
 821    --  is present in the options string.
 822 
 823    declare
 824       type Arg_Array is array (Nat) of Big_String_Ptr;
 825       type Arg_Array_Ptr is access Arg_Array;
 826       --  Types to access compiler arguments
 827 
 828       save_argc : Nat;
 829       pragma Import (C, save_argc);
 830       --  Saved value of argc (number of arguments), imported from misc.c
 831 
 832       save_argv : Arg_Array_Ptr;
 833       pragma Import (C, save_argv);
 834       --  Saved value of argv (argument pointers), imported from misc.c
 835 
 836       gnat_argc : Nat;
 837       gnat_argv : Arg_Array_Ptr;
 838       pragma Import (C, gnat_argc);
 839       pragma Import (C, gnat_argv);
 840       --  If save_argv is not set, default to gnat_argc/argv
 841 
 842       argc : Nat;
 843       argv : Arg_Array_Ptr;
 844 
 845       function Len_Arg (Arg : Big_String_Ptr) return Nat;
 846       --  Determine length of argument Arg (a nul terminated C string).
 847 
 848       -------------
 849       -- Len_Arg --
 850       -------------
 851 
 852       function Len_Arg (Arg : Big_String_Ptr) return Nat is
 853       begin
 854          for J in 1 .. Nat'Last loop
 855             if Arg (Natural (J)) = ASCII.NUL then
 856                return J - 1;
 857             end if;
 858          end loop;
 859 
 860          raise Program_Error;
 861       end Len_Arg;
 862 
 863    begin
 864       if save_argv /= null then
 865          argv := save_argv;
 866          argc := save_argc;
 867       else
 868          --  Case of a non gcc compiler, e.g. gnat2why or gnat2scil
 869          argv := gnat_argv;
 870          argc := gnat_argc;
 871       end if;
 872 
 873       --  Loop through arguments looking for -gnateT, also look for -gnatd.b
 874 
 875       for Arg in 1 .. argc - 1 loop
 876          declare
 877             Argv_Ptr : constant Big_String_Ptr := argv (Arg);
 878             Argv_Len : constant Nat            := Len_Arg (Argv_Ptr);
 879 
 880          begin
 881             if Argv_Len > 8
 882               and then Argv_Ptr (1 .. 8) = "-gnateT="
 883             then
 884                Opt.Target_Dependent_Info_Read_Name :=
 885                  new String'(Argv_Ptr (9 .. Natural (Argv_Len)));
 886 
 887             elsif Argv_Len >= 8
 888               and then Argv_Ptr (1 .. 8) = "-gnatd.b"
 889             then
 890                Debug_Flag_Dot_B := True;
 891             end if;
 892          end;
 893       end loop;
 894    end;
 895 
 896    --  Case of reading the target dependent values from file
 897 
 898    --  This is bit more complex than might be expected, because it has to be
 899    --  done very early. All kinds of packages depend on these values, and we
 900    --  can't wait till the normal processing of reading command line switches
 901    --  etc to read the file. We do this at the System.OS_Lib level since it is
 902    --  too early to be using Osint directly.
 903 
 904    if Opt.Target_Dependent_Info_Read_Name /= null then
 905       Read_Target_Dependent_Values (Target_Dependent_Info_Read_Name.all);
 906    else
 907       --  If the back-end comes with a target config file, then use it
 908       --  to set the values
 909 
 910       declare
 911          Back_End_Config_File : constant String_Ptr :=
 912            Get_Back_End_Config_File;
 913       begin
 914          if Back_End_Config_File /= null then
 915             Read_Target_Dependent_Values (Back_End_Config_File.all);
 916 
 917          --  Otherwise we get all values from the back end directly
 918 
 919          else
 920             Bits_BE                    := Get_Bits_BE;
 921             Bits_Per_Unit              := Get_Bits_Per_Unit;
 922             Bits_Per_Word              := Get_Bits_Per_Word;
 923             Bytes_BE                   := Get_Bytes_BE;
 924             Char_Size                  := Get_Char_Size;
 925             Double_Float_Alignment     := Get_Double_Float_Alignment;
 926             Double_Scalar_Alignment    := Get_Double_Scalar_Alignment;
 927             Float_Words_BE             := Get_Float_Words_BE;
 928             Int_Size                   := Get_Int_Size;
 929             Long_Long_Size             := Get_Long_Long_Size;
 930             Long_Size                  := Get_Long_Size;
 931             Maximum_Alignment          := Get_Maximum_Alignment;
 932             Max_Unaligned_Field        := Get_Max_Unaligned_Field;
 933             Pointer_Size               := Get_Pointer_Size;
 934             Short_Enums                := Get_Short_Enums;
 935             Short_Size                 := Get_Short_Size;
 936             Strict_Alignment           := Get_Strict_Alignment;
 937             System_Allocator_Alignment := Get_System_Allocator_Alignment;
 938             Wchar_T_Size               := Get_Wchar_T_Size;
 939             Words_BE                   := Get_Words_BE;
 940 
 941             --  Let the back-end register its floating point types and compute
 942             --  the sizes of our standard types from there:
 943 
 944             Num_FPT_Modes := 0;
 945             Register_Back_End_Types (Register_Float_Type'Access);
 946 
 947             declare
 948                T : FPT_Mode_Entry renames
 949                  FPT_Mode_Table (FPT_Mode_Index_For (S_Float));
 950             begin
 951                Float_Size := Pos (T.SIZE);
 952             end;
 953 
 954             declare
 955                T : FPT_Mode_Entry renames
 956                  FPT_Mode_Table (FPT_Mode_Index_For (S_Long_Float));
 957             begin
 958                Double_Size := Pos (T.SIZE);
 959             end;
 960 
 961             declare
 962                T : FPT_Mode_Entry renames
 963                  FPT_Mode_Table (FPT_Mode_Index_For (S_Long_Long_Float));
 964             begin
 965                Long_Double_Size := Pos (T.SIZE);
 966             end;
 967 
 968          end if;
 969       end;
 970    end if;
 971 end Set_Targ;