------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                             S E T _ T A R G                              --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 2013-2021, Free Software Foundation, Inc.         --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license.          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------

with Debug;    use Debug;
with Get_Targ; use Get_Targ;
with Opt;      use Opt;
with Output;   use Output;

with System;        use System;
with System.OS_Lib; use System.OS_Lib;

with Unchecked_Conversion;

package body Set_Targ is

   --------------------------------------------------------
   -- Data Used to Read/Write Target Dependent Info File --
   --------------------------------------------------------

   --  Table of string names written to file

   subtype Str is String;

   S_Bits_BE                    : constant Str := "Bits_BE";
   S_Bits_Per_Unit              : constant Str := "Bits_Per_Unit";
   S_Bits_Per_Word              : constant Str := "Bits_Per_Word";
   S_Bytes_BE                   : constant Str := "Bytes_BE";
   S_Char_Size                  : constant Str := "Char_Size";
   S_Double_Float_Alignment     : constant Str := "Double_Float_Alignment";
   S_Double_Scalar_Alignment    : constant Str := "Double_Scalar_Alignment";
   S_Double_Size                : constant Str := "Double_Size";
   S_Float_Size                 : constant Str := "Float_Size";
   S_Float_Words_BE             : constant Str := "Float_Words_BE";
   S_Int_Size                   : constant Str := "Int_Size";
   S_Long_Double_Size           : constant Str := "Long_Double_Size";
   S_Long_Long_Long_Size        : constant Str := "Long_Long_Long_Size";
   S_Long_Long_Size             : constant Str := "Long_Long_Size";
   S_Long_Size                  : constant Str := "Long_Size";
   S_Maximum_Alignment          : constant Str := "Maximum_Alignment";
   S_Max_Unaligned_Field        : constant Str := "Max_Unaligned_Field";
   S_Pointer_Size               : constant Str := "Pointer_Size";
   S_Short_Enums                : constant Str := "Short_Enums";
   S_Short_Size                 : constant Str := "Short_Size";
   S_Strict_Alignment           : constant Str := "Strict_Alignment";
   S_System_Allocator_Alignment : constant Str := "System_Allocator_Alignment";
   S_Wchar_T_Size               : constant Str := "Wchar_T_Size";
   S_Words_BE                   : constant Str := "Words_BE";

   --  Table of names

   type AStr is access all String;

   DTN : constant array (Nat range <>) of AStr := (
          S_Bits_BE                    'Unrestricted_Access,
          S_Bits_Per_Unit              'Unrestricted_Access,
          S_Bits_Per_Word              'Unrestricted_Access,
          S_Bytes_BE                   'Unrestricted_Access,
          S_Char_Size                  'Unrestricted_Access,
          S_Double_Float_Alignment     'Unrestricted_Access,
          S_Double_Scalar_Alignment    'Unrestricted_Access,
          S_Double_Size                'Unrestricted_Access,
          S_Float_Size                 'Unrestricted_Access,
          S_Float_Words_BE             'Unrestricted_Access,
          S_Int_Size                   'Unrestricted_Access,
          S_Long_Double_Size           'Unrestricted_Access,
          S_Long_Long_Long_Size        'Unrestricted_Access,
          S_Long_Long_Size             'Unrestricted_Access,
          S_Long_Size                  'Unrestricted_Access,
          S_Maximum_Alignment          'Unrestricted_Access,
          S_Max_Unaligned_Field        'Unrestricted_Access,
          S_Pointer_Size               'Unrestricted_Access,
          S_Short_Enums                'Unrestricted_Access,
          S_Short_Size                 'Unrestricted_Access,
          S_Strict_Alignment           'Unrestricted_Access,
          S_System_Allocator_Alignment 'Unrestricted_Access,
          S_Wchar_T_Size               'Unrestricted_Access,
          S_Words_BE                   'Unrestricted_Access);

   --  Table of corresponding value pointers

   DTV : constant array (Nat range <>) of System.Address := (
          Bits_BE                    'Address,
          Bits_Per_Unit              'Address,
          Bits_Per_Word              'Address,
          Bytes_BE                   'Address,
          Char_Size                  'Address,
          Double_Float_Alignment     'Address,
          Double_Scalar_Alignment    'Address,
          Double_Size                'Address,
          Float_Size                 'Address,
          Float_Words_BE             'Address,
          Int_Size                   'Address,
          Long_Double_Size           'Address,
          Long_Long_Long_Size        'Address,
          Long_Long_Size             'Address,
          Long_Size                  'Address,
          Maximum_Alignment          'Address,
          Max_Unaligned_Field        'Address,
          Pointer_Size               'Address,
          Short_Enums                'Address,
          Short_Size                 'Address,
          Strict_Alignment           'Address,
          System_Allocator_Alignment 'Address,
          Wchar_T_Size               'Address,
          Words_BE                   'Address);

   DTR : array (Nat range DTV'Range) of Boolean := (others => False);
   --  Table of flags used to validate that all values are present in file

   -----------------------
   -- Local Subprograms --
   -----------------------

   procedure Read_Target_Dependent_Values (File_Name : String);
   --  Read target dependent values from File_Name, and set the target
   --  dependent values (global variables) declared in this package.

   procedure Fail (E : String);
   pragma No_Return (Fail);
   --  Terminate program with fatal error message passed as parameter

   procedure Register_Float_Type
     (Name      : C_String;
      Digs      : Natural;
      Complex   : Boolean;
      Count     : Natural;
      Float_Rep : Float_Rep_Kind;
      Precision : Positive;
      Size      : Positive;
      Alignment : Natural);
   pragma Convention (C, Register_Float_Type);
   --  Call back to allow the back end to register available types. This call
   --  back makes entries in the FPT_Mode_Table for any floating point types
   --  reported by the back end. Name is the name of the type as a normal
   --  format Null-terminated string. Digs is the number of digits, where 0
   --  means it is not a fpt type (ignored during registration). Complex is
   --  non-zero if the type has real and imaginary parts (also ignored during
   --  registration). Count is the number of elements in a vector type (zero =
   --  not a vector, registration ignores vectors). Float_Rep shows the kind of
   --  floating-point type, and Precision, Size and Alignment are the precision
   --  size and alignment in bits.
   --
   --  The only types that are actually registered have Digs non-zero, Complex
   --  zero (false), and Count zero (not a vector). The Long_Double_Index
   --  variable below is updated to indicate the index at which a "long double"
   --  type can be found if it gets registered at all.

   Long_Double_Index : Integer := -1;
   --  Once all the floating point types have been registered, the index in
   --  FPT_Mode_Table at which "long double" can be found, if anywhere. A
   --  negative value means that no "long double" has been registered. This
   --  is useful to know whether we have a "long double" available at all and
   --  get at it's characteristics without having to search the FPT_Mode_Table
   --  when we need to decide which C type should be used as the basis for
   --  Long_Long_Float in Ada.

   function FPT_Mode_Index_For (Name : String) return Natural;
   --  Return the index in FPT_Mode_Table that designates the entry
   --  corresponding to the C type named Name. Raise Program_Error if
   --  there is no such entry.

   function FPT_Mode_Index_For (T : S_Float_Types) return Natural;
   --  Return the index in FPT_Mode_Table that designates the entry for
   --  a back-end type suitable as a basis to construct the standard Ada
   --  floating point type identified by T.

   ----------------
   -- C_Type_For --
   ----------------

   function C_Type_For (T : S_Float_Types) return String is

      --  ??? For now, we don't have a good way to tell the widest float
      --  type with hardware support. Basically, GCC knows the size of that
      --  type, but on x86-64 there often are two or three 128-bit types,
      --  one double extended that has 18 decimal digits, a 128-bit quad
      --  precision type with 33 digits and possibly a 128-bit decimal float
      --  type with 34 digits. As a workaround, we define Long_Long_Float as
      --  C's "long double" if that type exists and has at most 18 digits,
      --  or otherwise the same as Long_Float.

      Max_HW_Digs : constant := 18;
      --  Maximum hardware digits supported

   begin
      case T is
         when S_Float
            | S_Short_Float
         =>
            return "float";

         when S_Long_Float =>
            return "double";

         when S_Long_Long_Float =>
            if Long_Double_Index >= 0
              and then FPT_Mode_Table (Long_Double_Index).DIGS <= Max_HW_Digs
            then
               return "long double";
            else
               return "double";
            end if;
      end case;
   end C_Type_For;

   ----------
   -- Fail --
   ----------

   procedure Fail (E : String) is
      E_Fatal : constant := 4;
      --  Code for fatal error

   begin
      Write_Str (E);
      Write_Eol;
      OS_Exit (E_Fatal);
   end Fail;

   ------------------------
   -- FPT_Mode_Index_For --
   ------------------------

   function FPT_Mode_Index_For (Name : String) return Natural is
   begin
      for J in FPT_Mode_Table'First .. Num_FPT_Modes loop
         if FPT_Mode_Table (J).NAME.all = Name then
            return J;
         end if;
      end loop;

      raise Program_Error;
   end FPT_Mode_Index_For;

   function FPT_Mode_Index_For (T : S_Float_Types) return Natural is
   begin
      return FPT_Mode_Index_For (C_Type_For (T));
   end FPT_Mode_Index_For;

   -------------------------
   -- Register_Float_Type --
   -------------------------

   procedure Register_Float_Type
     (Name      : C_String;
      Digs      : Natural;
      Complex   : Boolean;
      Count     : Natural;
      Float_Rep : Float_Rep_Kind;
      Precision : Positive;
      Size      : Positive;
      Alignment : Natural)
   is
      T    : String (1 .. Name'Length);
      Last : Natural := 0;

      procedure Dump;
      --  Dump information given by the back end for the type to register

      ----------
      -- Dump --
      ----------

      procedure Dump is
      begin
         Write_Str ("type " & T (1 .. Last) & " is ");

         if Count > 0 then
            Write_Str ("array (1 .. ");
            Write_Int (Int (Count));

            if Complex then
               Write_Str (", 1 .. 2");
            end if;

            Write_Str (") of ");

         elsif Complex then
            Write_Str ("array (1 .. 2) of ");
         end if;

         if Digs > 0 then
            Write_Str ("digits ");
            Write_Int (Int (Digs));
            Write_Line (";");

            Write_Str ("pragma Float_Representation (");

            case Float_Rep is
               when AAMP        => Write_Str ("AAMP");
               when IEEE_Binary => Write_Str ("IEEE");
            end case;

            Write_Line (", " & T (1 .. Last) & ");");

         else
            Write_Str ("mod 2**");
            Write_Int (Int (Precision / Positive'Max (1, Count)));
            Write_Line (";");
         end if;

         if Precision = Size then
            Write_Str ("for " & T (1 .. Last) & "'Size use ");
            Write_Int (Int (Size));
            Write_Line (";");

         else
            Write_Str ("for " & T (1 .. Last) & "'Value_Size use ");
            Write_Int (Int (Precision));
            Write_Line (";");

            Write_Str ("for " & T (1 .. Last) & "'Object_Size use ");
            Write_Int (Int (Size));
            Write_Line (";");
         end if;

         Write_Str ("for " & T (1 .. Last) & "'Alignment use ");
         Write_Int (Int (Alignment / 8));
         Write_Line (";");
         Write_Eol;
      end Dump;

   --  Start of processing for Register_Float_Type

   begin
      --  Acquire name

      for J in T'Range loop
         T (J) := Name (Name'First + J - 1);

         if T (J) = ASCII.NUL then
            Last := J - 1;
            exit;
         end if;
      end loop;

      --  Dump info if debug flag set

      if Debug_Flag_Dot_B then
         Dump;
      end if;

      --  Acquire entry if non-vector non-complex fpt type (digits non-zero)

      if Digs > 0 and then not Complex and then Count = 0 then

         declare
            This_Name : constant String := T (1 .. Last);
         begin
            Num_FPT_Modes := Num_FPT_Modes + 1;
            FPT_Mode_Table (Num_FPT_Modes) :=
              (NAME      => new String'(This_Name),
               DIGS      => Digs,
               FLOAT_REP => Float_Rep,
               PRECISION => Precision,
               SIZE      => Size,
               ALIGNMENT => Alignment);

            if Long_Double_Index < 0 and then This_Name = "long double" then
               Long_Double_Index := Num_FPT_Modes;
            end if;
         end;
      end if;
   end Register_Float_Type;

   -----------------------------------
   -- Write_Target_Dependent_Values --
   -----------------------------------

   --  We do this at the System.Os_Lib level, since we have to do the read at
   --  that level anyway, so it is easier and more consistent to follow the
   --  same path for the write.

   procedure Write_Target_Dependent_Values is
      Fdesc  : File_Descriptor;
      OK     : Boolean;

      Buffer : String (1 .. 80);
      Buflen : Natural;
      --  Buffer used to build line one of file

      type ANat is access all Natural;
      --  Pointer to Nat or Pos value (it is harmless to treat Pos values and
      --  Nat values as Natural via Unchecked_Conversion).

      function To_ANat is new Unchecked_Conversion (Address, ANat);

      procedure AddC (C : Character);
      --  Add one character to buffer

      procedure AddN (N : Natural);
      --  Add representation of integer N to Buffer, updating Buflen. N
      --  must be less than 1000, and output is 3 characters with leading
      --  spaces as needed.

      procedure Write_Line;
      --  Output contents of Buffer (1 .. Buflen) followed by a New_Line,
      --  and set Buflen back to zero, ready to write next line.

      ----------
      -- AddC --
      ----------

      procedure AddC (C : Character) is
      begin
         Buflen := Buflen + 1;
         Buffer (Buflen) := C;
      end AddC;

      ----------
      -- AddN --
      ----------

      procedure AddN (N : Natural) is
      begin
         if N > 999 then
            raise Program_Error;
         end if;

         if N > 99 then
            AddC (Character'Val (48 + N / 100));
         else
            AddC (' ');
         end if;

         if N > 9 then
            AddC (Character'Val (48 + N / 10 mod 10));
         else
            AddC (' ');
         end if;

         AddC (Character'Val (48 + N mod 10));
      end AddN;

      ----------------
      -- Write_Line --
      ----------------

      procedure Write_Line is
      begin
         AddC (ASCII.LF);

         if Buflen /= Write (Fdesc, Buffer'Address, Buflen) then
            Delete_File (Target_Dependent_Info_Write_Name.all, OK);
            Fail ("disk full writing file "
                  & Target_Dependent_Info_Write_Name.all);
         end if;

         Buflen := 0;
      end Write_Line;

   --  Start of processing for Write_Target_Dependent_Values

   begin
      Fdesc :=
        Create_File (Target_Dependent_Info_Write_Name.all, Text);

      if Fdesc = Invalid_FD then
         Fail ("cannot create file " & Target_Dependent_Info_Write_Name.all);
      end if;

      --  Loop through values

      for J in DTN'Range loop

         --  Output name

         Buflen := DTN (J)'Length;
         Buffer (1 .. Buflen) := DTN (J).all;

         --  Line up values

         while Buflen < 26 loop
            AddC (' ');
         end loop;

         AddC (' ');
         AddC (' ');

         --  Output value and write line

         AddN (To_ANat (DTV (J)).all);
         Write_Line;
      end loop;

      --  Blank line to separate sections

      Write_Line;

      --  Write lines for registered FPT types

      for J in 1 .. Num_FPT_Modes loop
         declare
            E : FPT_Mode_Entry renames FPT_Mode_Table (J);
         begin
            Buflen := E.NAME'Last;
            Buffer (1 .. Buflen) := E.NAME.all;

            --  Pad out to line up values

            while Buflen < 11 loop
               AddC (' ');
            end loop;

            AddC (' ');
            AddC (' ');

            AddN (E.DIGS);
            AddC (' ');
            AddC (' ');

            case E.FLOAT_REP is
               when AAMP        => AddC ('A');
               when IEEE_Binary => AddC ('I');
            end case;

            AddC (' ');

            AddN (E.PRECISION);
            AddC (' ');

            AddN (E.ALIGNMENT);
            Write_Line;
         end;
      end loop;

      --  Close file

      Close (Fdesc, OK);

      if not OK then
         Fail ("disk full writing file "
               & Target_Dependent_Info_Write_Name.all);
      end if;
   end Write_Target_Dependent_Values;

   ----------------------------------
   -- Read_Target_Dependent_Values --
   ----------------------------------

   procedure Read_Target_Dependent_Values (File_Name : String) is
      File_Desc : File_Descriptor;
      N         : Natural;

      type ANat is access all Natural;
      --  Pointer to Nat or Pos value (it is harmless to treat Pos values
      --  as Nat via Unchecked_Conversion).

      function To_ANat is new Unchecked_Conversion (Address, ANat);

      VP : ANat;

      Buffer : String (1 .. 2000);
      Buflen : Natural;
      --  File information and length (2000 easily enough)

      Nam_Buf : String (1 .. 40);
      Nam_Len : Natural;

      procedure Check_Spaces;
      --  Checks that we have one or more spaces and skips them

      procedure FailN (S : String);
      pragma No_Return (FailN);
      --  Calls Fail adding " name in file xxx", where name is the currently
      --  gathered name in Nam_Buf, surrounded by quotes, and xxx is the
      --  name of the file.

      procedure Get_Name;
      --  Scan out name, leaving it in Nam_Buf with Nam_Len set. Calls
      --  Skip_Spaces to skip any following spaces. Note that the name is
      --  terminated by a sequence of at least two spaces.

      function Get_Nat return Natural;
      --  N on entry points to decimal integer, scan out decimal integer
      --  and return it, leaving N pointing to following space or LF.

      procedure Skip_Spaces;
      --  Skip past spaces

      ------------------
      -- Check_Spaces --
      ------------------

      procedure Check_Spaces is
      begin
         if N > Buflen or else Buffer (N) /= ' ' then
            FailN ("missing space for");
         end if;

         Skip_Spaces;
         return;
      end Check_Spaces;

      -----------
      -- FailN --
      -----------

      procedure FailN (S : String) is
      begin
         Fail (S & " """ & Nam_Buf (1 .. Nam_Len) & """ in file "
               & File_Name);
      end FailN;

      --------------
      -- Get_Name --
      --------------

      procedure Get_Name is
      begin
         Nam_Len := 0;

         --  Scan out name and put it in Nam_Buf

         loop
            if N > Buflen or else Buffer (N) = ASCII.LF then
               FailN ("incorrectly formatted line for");
            end if;

            --  Name is terminated by two blanks

            exit when N < Buflen and then Buffer (N .. N + 1) = "  ";

            Nam_Len := Nam_Len + 1;

            if Nam_Len > Nam_Buf'Last then
               Fail ("name too long");
            end if;

            Nam_Buf (Nam_Len) := Buffer (N);
            N := N + 1;
         end loop;

         Check_Spaces;
      end Get_Name;

      -------------
      -- Get_Nat --
      -------------

      function Get_Nat return Natural is
         Result : Natural := 0;

      begin
         loop
            if N > Buflen
              or else Buffer (N) not in '0' .. '9'
              or else Result > 999
            then
               FailN ("bad value for");
            end if;

            Result := Result * 10 + (Character'Pos (Buffer (N)) - 48);
            N := N + 1;

            exit when N <= Buflen
              and then (Buffer (N) = ASCII.LF or else Buffer (N) = ' ');
         end loop;

         return Result;
      end Get_Nat;

      -----------------
      -- Skip_Spaces --
      -----------------

      procedure Skip_Spaces is
      begin
         while N <= Buflen and Buffer (N) = ' ' loop
            N := N + 1;
         end loop;
      end Skip_Spaces;

   --  Start of processing for Read_Target_Dependent_Values

   begin
      File_Desc := Open_Read (File_Name, Text);

      if File_Desc = Invalid_FD then
         Fail ("cannot read file " & File_Name);
      end if;

      Buflen := Read (File_Desc, Buffer'Address, Buffer'Length);

      Close (File_Desc);

      if Buflen = Buffer'Length then
         Fail ("file is too long: " & File_Name);
      end if;

      --  Scan through file for properly formatted entries in first section

      N := 1;
      while N <= Buflen and then Buffer (N) /= ASCII.LF loop
         Get_Name;

         --  Validate name and get corresponding value pointer

         VP := null;

         for J in DTN'Range loop
            if DTN (J).all = Nam_Buf (1 .. Nam_Len) then
               VP := To_ANat (DTV (J));
               DTR (J) := True;
               exit;
            end if;
         end loop;

         if VP = null then
            FailN ("unrecognized name");
         end if;

         --  Scan out value

         VP.all := Get_Nat;

         if N > Buflen or else Buffer (N) /= ASCII.LF then
            FailN ("misformatted line for");
         end if;

         N := N + 1; -- skip LF
      end loop;

      --  Fall through this loop when all lines in first section read.
      --  Check that values have been supplied for all entries.

      for J in DTR'Range loop
         if not DTR (J) then
            --  Make an exception for Long_Long_Long_Size???

            if DTN (J) = S_Long_Long_Long_Size'Unrestricted_Access then
               Long_Long_Long_Size := Long_Long_Size;

            else
               Fail ("missing entry for " & DTN (J).all & " in file "
                     & File_Name);
            end if;
         end if;
      end loop;

      --  Now acquire FPT entries

      if N >= Buflen then
         Fail ("missing entries for FPT modes in file " & File_Name);
      end if;

      if Buffer (N) = ASCII.LF then
         N := N + 1;
      else
         Fail ("missing blank line in file " & File_Name);
      end if;

      Num_FPT_Modes := 0;
      while N <= Buflen loop
         Get_Name;

         Num_FPT_Modes := Num_FPT_Modes + 1;

         declare
            E : FPT_Mode_Entry renames FPT_Mode_Table (Num_FPT_Modes);

         begin
            E.NAME := new String'(Nam_Buf (1 .. Nam_Len));

            if Long_Double_Index < 0 and then E.NAME.all = "long double" then
               Long_Double_Index := Num_FPT_Modes;
            end if;

            E.DIGS := Get_Nat;
            Check_Spaces;

            case Buffer (N) is
               when 'I'    =>
                  E.FLOAT_REP := IEEE_Binary;

               when 'A'    =>
                  E.FLOAT_REP := AAMP;

               when others =>
                  FailN ("bad float rep field for");
            end case;

            N := N + 1;
            Check_Spaces;

            E.PRECISION := Get_Nat;
            Check_Spaces;

            E.ALIGNMENT := Get_Nat;

            if Buffer (N) /= ASCII.LF then
               FailN ("junk at end of line for");
            end if;

            --  ??? We do not read E.SIZE, see Write_Target_Dependent_Values

            E.SIZE :=
              (E.PRECISION + E.ALIGNMENT - 1) / E.ALIGNMENT * E.ALIGNMENT;

            N := N + 1;
         end;
      end loop;
   end Read_Target_Dependent_Values;

--  Package Initialization, set target dependent values. This must be done
--  early on, before we start accessing various compiler packages, since
--  these values are used all over the place.

begin
   --  First step: see if the -gnateT switch is present. As we have noted,
   --  this has to be done very early, so cannot depend on the normal circuit
   --  for reading switches and setting switches in Opt. The following code
   --  will set Opt.Target_Dependent_Info_Read_Name if the switch -gnateT=name
   --  is present in the options string.

   declare
      type Arg_Array is array (Nat) of Big_String_Ptr;
      type Arg_Array_Ptr is access Arg_Array;
      --  Types to access compiler arguments

      save_argc : Nat;
      pragma Import (C, save_argc);
      --  Saved value of argc (number of arguments), imported from misc.c

      save_argv : Arg_Array_Ptr;
      pragma Import (C, save_argv);
      --  Saved value of argv (argument pointers), imported from misc.c

      gnat_argc : Nat;
      gnat_argv : Arg_Array_Ptr;
      pragma Import (C, gnat_argc);
      pragma Import (C, gnat_argv);
      --  If save_argv is not set, default to gnat_argc/argv

      argc : Nat;
      argv : Arg_Array_Ptr;

      function Len_Arg (Arg : Big_String_Ptr) return Nat;
      --  Determine length of argument Arg (a nul terminated C string).

      -------------
      -- Len_Arg --
      -------------

      function Len_Arg (Arg : Big_String_Ptr) return Nat is
      begin
         for J in 1 .. Nat'Last loop
            if Arg (Natural (J)) = ASCII.NUL then
               return J - 1;
            end if;
         end loop;

         raise Program_Error;
      end Len_Arg;

   begin
      if save_argv /= null then
         argv := save_argv;
         argc := save_argc;
      else
         --  Case of a non gcc compiler, e.g. gnat2why or gnat2scil
         argv := gnat_argv;
         argc := gnat_argc;
      end if;

      --  Loop through arguments looking for -gnateT, also look for -gnatd.b

      for Arg in 1 .. argc - 1 loop
         declare
            Argv_Ptr : constant Big_String_Ptr := argv (Arg);
            Argv_Len : constant Nat            := Len_Arg (Argv_Ptr);

         begin
            if Argv_Len > 8
              and then Argv_Ptr (1 .. 8) = "-gnateT="
            then
               Opt.Target_Dependent_Info_Read_Name :=
                 new String'(Argv_Ptr (9 .. Natural (Argv_Len)));

            elsif Argv_Len >= 8
              and then Argv_Ptr (1 .. 8) = "-gnatd.b"
            then
               Debug_Flag_Dot_B := True;
            end if;
         end;
      end loop;
   end;

   --  Case of reading the target dependent values from file

   --  This is bit more complex than might be expected, because it has to be
   --  done very early. All kinds of packages depend on these values, and we
   --  can't wait till the normal processing of reading command line switches
   --  etc to read the file. We do this at the System.OS_Lib level since it is
   --  too early to be using Osint directly.

   if Opt.Target_Dependent_Info_Read_Name /= null then
      Read_Target_Dependent_Values (Target_Dependent_Info_Read_Name.all);
   else
      --  If the back-end comes with a target config file, then use it
      --  to set the values

      declare
         Back_End_Config_File : constant String_Ptr :=
           Get_Back_End_Config_File;
      begin
         if Back_End_Config_File /= null then
            pragma Gnat_Annotate
              (CodePeer, Intentional, "test always false",
               "some variant body will return non null");
            Read_Target_Dependent_Values (Back_End_Config_File.all);

         --  Otherwise we get all values from the back end directly

         else
            Bits_BE                    := Get_Bits_BE;
            Bits_Per_Unit              := Get_Bits_Per_Unit;
            Bits_Per_Word              := Get_Bits_Per_Word;
            Bytes_BE                   := Get_Bytes_BE;
            Char_Size                  := Get_Char_Size;
            Double_Float_Alignment     := Get_Double_Float_Alignment;
            Double_Scalar_Alignment    := Get_Double_Scalar_Alignment;
            Float_Words_BE             := Get_Float_Words_BE;
            Int_Size                   := Get_Int_Size;
            Long_Long_Long_Size        := Get_Long_Long_Long_Size;
            Long_Long_Size             := Get_Long_Long_Size;
            Long_Size                  := Get_Long_Size;
            Maximum_Alignment          := Get_Maximum_Alignment;
            Max_Unaligned_Field        := Get_Max_Unaligned_Field;
            Pointer_Size               := Get_Pointer_Size;
            Short_Enums                := Get_Short_Enums;
            Short_Size                 := Get_Short_Size;
            Strict_Alignment           := Get_Strict_Alignment;
            System_Allocator_Alignment := Get_System_Allocator_Alignment;
            Wchar_T_Size               := Get_Wchar_T_Size;
            Words_BE                   := Get_Words_BE;

            --  Let the back-end register its floating point types and compute
            --  the sizes of our standard types from there:

            Num_FPT_Modes := 0;
            Register_Back_End_Types (Register_Float_Type'Access);

            declare
               T : FPT_Mode_Entry renames
                 FPT_Mode_Table (FPT_Mode_Index_For (S_Float));
            begin
               Float_Size := Pos (T.SIZE);
            end;

            declare
               T : FPT_Mode_Entry renames
                 FPT_Mode_Table (FPT_Mode_Index_For (S_Long_Float));
            begin
               Double_Size := Pos (T.SIZE);
            end;

            declare
               T : FPT_Mode_Entry renames
                 FPT_Mode_Table (FPT_Mode_Index_For (S_Long_Long_Float));
            begin
               Long_Double_Size := Pos (T.SIZE);
            end;

         end if;
      end;
   end if;
end Set_Targ;