Nano_Allwinner
/
ubuntu-buildroot
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
ubuntu-buildroot/output/build/host-gcc-initial-11.4.0/gcc/ada/set_targ.adb

991 lines
32 KiB
Ada
Raw Blame History

------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E T _ T A R G --
-- --
-- B o d y --
-- --
-- Copyright (C) 2013-2020, 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;
Reference in New Issue View Git Blame Copy Permalink