From 18e829474cbb8624570a9836ceee1d8544b0ace7 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 25 Apr 2017 08:25:29 +0000 Subject: [PATCH] New file. From-SVN: r247145 --- gcc/ada/ChangeLog | 4 + gcc/ada/ada_get_targ.adb | 328 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 332 insertions(+) create mode 100644 gcc/ada/ada_get_targ.adb diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 9899f93fe3f..d74dfff7e9a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,7 @@ +2017-04-25 Arnaud Charlet + + * ada_get_targ.adb: New file. + 2017-04-25 Bob Duff * uintp.adb (Most_Sig_2_Digits): In case Direct (Right), fetch diff --git a/gcc/ada/ada_get_targ.adb b/gcc/ada/ada_get_targ.adb new file mode 100644 index 00000000000..03b91444426 --- /dev/null +++ b/gcc/ada/ada_get_targ.adb @@ -0,0 +1,328 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- G E T _ T A R G -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 1992-2017, 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. -- +-- -- +------------------------------------------------------------------------------ + +-- Version shared by various Ada based back-ends (e.g. gnat2scil, gnat2why) + +with System.OS_Lib; use System.OS_Lib; + +with GNAT.Directory_Operations; use GNAT.Directory_Operations; + +package body Get_Targ is + + ----------------------- + -- Get_Bits_Per_Unit -- + ----------------------- + + function Get_Bits_Per_Unit return Pos is + begin + return 8; + end Get_Bits_Per_Unit; + + ----------------------- + -- Get_Bits_Per_Word -- + ----------------------- + + function Get_Bits_Per_Word return Pos is + begin + return 32; + end Get_Bits_Per_Word; + + ------------------- + -- Get_Char_Size -- + ------------------- + + function Get_Char_Size return Pos is + begin + return 8; + end Get_Char_Size; + + ----------------- + -- Get_Wchar_T -- + ----------------- + + function Get_Wchar_T_Size return Pos is + begin + return 16; + end Get_Wchar_T_Size; + + -------------------- + -- Get_Short_Size -- + -------------------- + + function Get_Short_Size return Pos is + begin + return 16; + end Get_Short_Size; + + ------------------ + -- Get_Int_Size -- + ------------------ + + function Get_Int_Size return Pos is + begin + return 32; + end Get_Int_Size; + + ------------------- + -- Get_Long_Size -- + ------------------- + + function Get_Long_Size return Pos is + begin + return 64; + end Get_Long_Size; + + ------------------------ + -- Get_Long_Long_Size -- + ------------------------ + + function Get_Long_Long_Size return Pos is + begin + return 64; + end Get_Long_Long_Size; + + ---------------------- + -- Get_Pointer_Size -- + ---------------------- + + function Get_Pointer_Size return Pos is + begin + return 64; + end Get_Pointer_Size; + + --------------------------- + -- Get_Maximum_Alignment -- + --------------------------- + + function Get_Maximum_Alignment return Pos is + begin + return 4; + end Get_Maximum_Alignment; + + ------------------------------------ + -- Get_System_Allocator_Alignment -- + ------------------------------------ + + function Get_System_Allocator_Alignment return Nat is + begin + return 1; + end Get_System_Allocator_Alignment; + + ------------------------ + -- Get_Float_Words_BE -- + ------------------------ + + function Get_Float_Words_BE return Nat is + begin + return 1; + end Get_Float_Words_BE; + + ------------------ + -- Get_Words_BE -- + ------------------ + + function Get_Words_BE return Nat is + begin + return 1; + end Get_Words_BE; + + ------------------ + -- Get_Bytes_BE -- + ------------------ + + function Get_Bytes_BE return Nat is + begin + return 1; + end Get_Bytes_BE; + + ----------------- + -- Get_Bits_BE -- + ----------------- + + function Get_Bits_BE return Nat is + begin + return 1; + end Get_Bits_BE; + + --------------------- + -- Get_Short_Enums -- + --------------------- + + function Get_Short_Enums return Int is + begin + return 0; + end Get_Short_Enums; + + -------------------------- + -- Get_Strict_Alignment -- + -------------------------- + + function Get_Strict_Alignment return Nat is + begin + return 1; + end Get_Strict_Alignment; + + -------------------------------- + -- Get_Double_Float_Alignment -- + -------------------------------- + + function Get_Double_Float_Alignment return Nat is + begin + return 0; + end Get_Double_Float_Alignment; + + --------------------------------- + -- Get_Double_Scalar_Alignment -- + --------------------------------- + + function Get_Double_Scalar_Alignment return Nat is + begin + return 0; + end Get_Double_Scalar_Alignment; + + ----------------------------- + -- Get_Max_Unaligned_Field -- + ----------------------------- + + function Get_Max_Unaligned_Field return Pos is + begin + return 64; -- Can be different on some targets (e.g., AAMP) + end Get_Max_Unaligned_Field; + + ---------------------- + -- Digits_From_Size -- + ---------------------- + + function Digits_From_Size (Size : Pos) return Pos is + begin + case Size is + when 32 => return 6; + when 48 => return 9; + when 64 => return 15; + when 96 => return 18; + when 128 => return 18; + when others => raise Program_Error; + end case; + end Digits_From_Size; + + ----------------------------- + -- Register_Back_End_Types -- + ----------------------------- + + procedure Register_Back_End_Types (Call_Back : Register_Type_Proc) is + Float_Str : C_String := (others => ASCII.NUL); + Double_Str : C_String := (others => ASCII.NUL); + + begin + Float_Str (Float_Str'First .. Float_Str'First + 4) := "float"; + Call_Back + (C_Name => Float_Str, Digs => 6, Complex => False, Count => 0, + Float_Rep => IEEE_Binary, + Precision => 32, Size => 32, Alignment => 32); + + Double_Str (Double_Str'First .. Double_Str'First + 5) := "double"; + Call_Back + (C_Name => Double_Str, + Digs => 15, + Complex => False, + Count => 0, + Float_Rep => IEEE_Binary, + Precision => 64, + Size => 64, + Alignment => 64); + end Register_Back_End_Types; + + --------------------- + -- Width_From_Size -- + --------------------- + + function Width_From_Size (Size : Pos) return Pos is + begin + case Size is + when 8 => return 4; + when 16 => return 6; + when 32 => return 11; + when 64 => return 21; + when others => raise Program_Error; + end case; + end Width_From_Size; + + ------------------------------ + -- Get_Back_End_Config_File -- + ------------------------------ + + function Get_Back_End_Config_File return String_Ptr is + + function Exec_Name return String; + -- Return name of the current executable (from argv[0]) + + function Get_Target_File (Dir : String) return String_Ptr; + -- Return Dir & "target.atp" if found, null otherwise + + --------------- + -- Exec_Name -- + --------------- + + function Exec_Name return String is + type Arg_Array is array (Nat) of Big_String_Ptr; + type Arg_Array_Ptr is access all Arg_Array; + + gnat_argv : Arg_Array_Ptr; + pragma Import (C, gnat_argv); + + begin + for J in 1 .. Natural'Last loop + if gnat_argv (0) (J) = ASCII.NUL then + return gnat_argv (0) (1 .. J - 1); + end if; + end loop; + + raise Program_Error; + end Exec_Name; + + --------------------- + -- Get_Target_File -- + --------------------- + + function Get_Target_File (Dir : String) return String_Ptr is + F : constant String := Dir & "target.atp"; + begin + if Is_Regular_File (F) then + return new String'(F); + else + return null; + end if; + end Get_Target_File; + + Exec : constant String := Exec_Name; + + -- Start of processing for Get_Back_End_Config_File + + begin + if Is_Absolute_Path (Exec) then + return Get_Target_File (Dir_Name (Exec)); + else + return Get_Target_File (Dir_Name (Locate_Exec_On_Path (Exec).all)); + end if; + end Get_Back_End_Config_File; + +end Get_Targ; -- 2.30.2