Skip to content

R
riscv-gcc-1
Commit 18e82947 by Arnaud Charlet Committed by Arnaud Charlet
Options

New file. 

From-SVN: r247145
parent f607cacf
Showing with 332 additions and 0 deletions
gcc/ada/ChangeLog
2017-04-25 Arnaud Charlet <charlet@adacore.com>
* ada_get_targ.adb: New file.
2017-04-25 Bob Duff <duff@adacore.com> 2017-04-25 Bob Duff <duff@adacore.com>
* uintp.adb (Most_Sig_2_Digits): In case Direct (Right), fetch * uintp.adb (Most_Sig_2_Digits): In case Direct (Right), fetch
......
gcc/ada/ada_get_targ.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- 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;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment