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