gcc/ada/ada_get_targ.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             G E T _ T A R G                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2018, 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 ------------------------------------------------------------------------------
  22
  23 --  Version shared by various Ada based back-ends (e.g. gnat2scil, gnat2why)
  24
  25 with System.OS_Lib; use System.OS_Lib;
  26
  27 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
  28
  29 package body Get_Targ is
  30
  31    -----------------------
  32    -- Get_Bits_Per_Unit --
  33    -----------------------
  34
  35    function Get_Bits_Per_Unit return Pos is
  36    begin
  37       return 8;
  38    end Get_Bits_Per_Unit;
  39
  40    -----------------------
  41    -- Get_Bits_Per_Word --
  42    -----------------------
  43
  44    function Get_Bits_Per_Word return Pos is
  45    begin
  46       return 32;
  47    end Get_Bits_Per_Word;
  48
  49    -------------------
  50    -- Get_Char_Size --
  51    -------------------
  52
  53    function Get_Char_Size return Pos is
  54    begin
  55       return 8;
  56    end Get_Char_Size;
  57
  58    ----------------------
  59    -- Get_Wchar_T_Size --
  60    ----------------------
  61
  62    function Get_Wchar_T_Size return Pos is
  63    begin
  64       return 16;
  65    end Get_Wchar_T_Size;
  66
  67    --------------------
  68    -- Get_Short_Size --
  69    --------------------
  70
  71    function Get_Short_Size return Pos is
  72    begin
  73       return 16;
  74    end Get_Short_Size;
  75
  76    ------------------
  77    -- Get_Int_Size --
  78    ------------------
  79
  80    function Get_Int_Size return Pos is
  81    begin
  82       return 32;
  83    end Get_Int_Size;
  84
  85    -------------------
  86    -- Get_Long_Size --
  87    -------------------
  88
  89    function Get_Long_Size return Pos is
  90    begin
  91       return 64;
  92    end Get_Long_Size;
  93
  94    ------------------------
  95    -- Get_Long_Long_Size --
  96    ------------------------
  97
  98    function Get_Long_Long_Size return Pos is
  99    begin
 100       return 64;
 101    end Get_Long_Long_Size;
 102
 103    ----------------------
 104    -- Get_Pointer_Size --
 105    ----------------------
 106
 107    function Get_Pointer_Size return Pos is
 108    begin
 109       return 64;
 110    end Get_Pointer_Size;
 111
 112    ---------------------------
 113    -- Get_Maximum_Alignment --
 114    ---------------------------
 115
 116    function Get_Maximum_Alignment return Pos is
 117    begin
 118       return 4;
 119    end Get_Maximum_Alignment;
 120
 121    ------------------------------------
 122    -- Get_System_Allocator_Alignment --
 123    ------------------------------------
 124
 125    function Get_System_Allocator_Alignment return Nat is
 126    begin
 127       return 1;
 128    end Get_System_Allocator_Alignment;
 129
 130    ------------------------
 131    -- Get_Float_Words_BE --
 132    ------------------------
 133
 134    function Get_Float_Words_BE return Nat is
 135    begin
 136       return 1;
 137    end Get_Float_Words_BE;
 138
 139    ------------------
 140    -- Get_Words_BE --
 141    ------------------
 142
 143    function Get_Words_BE return Nat is
 144    begin
 145       return 1;
 146    end Get_Words_BE;
 147
 148    ------------------
 149    -- Get_Bytes_BE --
 150    ------------------
 151
 152    function Get_Bytes_BE return Nat is
 153    begin
 154       return 1;
 155    end Get_Bytes_BE;
 156
 157    -----------------
 158    -- Get_Bits_BE --
 159    -----------------
 160
 161    function Get_Bits_BE return Nat is
 162    begin
 163       return 1;
 164    end Get_Bits_BE;
 165
 166    ---------------------
 167    -- Get_Short_Enums --
 168    ---------------------
 169
 170    function Get_Short_Enums return Int is
 171    begin
 172       return 0;
 173    end Get_Short_Enums;
 174
 175    --------------------------
 176    -- Get_Strict_Alignment --
 177    --------------------------
 178
 179    function Get_Strict_Alignment return Nat is
 180    begin
 181       return 1;
 182    end Get_Strict_Alignment;
 183
 184    --------------------------------
 185    -- Get_Double_Float_Alignment --
 186    --------------------------------
 187
 188    function Get_Double_Float_Alignment return Nat is
 189    begin
 190       return 0;
 191    end Get_Double_Float_Alignment;
 192
 193    ---------------------------------
 194    -- Get_Double_Scalar_Alignment --
 195    ---------------------------------
 196
 197    function Get_Double_Scalar_Alignment return Nat is
 198    begin
 199       return 0;
 200    end Get_Double_Scalar_Alignment;
 201
 202    -----------------------------
 203    -- Get_Max_Unaligned_Field --
 204    -----------------------------
 205
 206    function Get_Max_Unaligned_Field return Pos is
 207    begin
 208       return 64;  -- Can be different on some targets (e.g., AAMP)
 209    end Get_Max_Unaligned_Field;
 210
 211    ----------------------
 212    -- Digits_From_Size --
 213    ----------------------
 214
 215    function Digits_From_Size (Size : Pos) return Pos is
 216    begin
 217       case Size is
 218          when  32    => return  6;
 219          when  48    => return  9;
 220          when  64    => return 15;
 221          when  96    => return 18;
 222          when 128    => return 18;
 223          when others => raise Program_Error;
 224       end case;
 225    end Digits_From_Size;
 226
 227    -----------------------------
 228    -- Register_Back_End_Types --
 229    -----------------------------
 230
 231    procedure Register_Back_End_Types (Call_Back : Register_Type_Proc) is
 232       Float_Str  : C_String := (others => ASCII.NUL);
 233       Double_Str : C_String := (others => ASCII.NUL);
 234
 235    begin
 236       Float_Str (Float_Str'First .. Float_Str'First + 4) := "float";
 237       Call_Back
 238         (C_Name => Float_Str, Digs => 6, Complex => False, Count  => 0,
 239          Float_Rep => IEEE_Binary,
 240          Precision => 32, Size => 32, Alignment => 32);
 241
 242       Double_Str (Double_Str'First .. Double_Str'First + 5) := "double";
 243       Call_Back
 244         (C_Name    => Double_Str,
 245          Digs      => 15,
 246          Complex   => False,
 247          Count     => 0,
 248          Float_Rep => IEEE_Binary,
 249          Precision => 64,
 250          Size      => 64,
 251          Alignment => 64);
 252    end Register_Back_End_Types;
 253
 254    ---------------------
 255    -- Width_From_Size --
 256    ---------------------
 257
 258    function Width_From_Size  (Size : Pos) return Pos is
 259    begin
 260       case Size is
 261          when  8     => return  4;
 262          when 16     => return  6;
 263          when 32     => return 11;
 264          when 64     => return 21;
 265          when others => raise Program_Error;
 266       end case;
 267    end Width_From_Size;
 268
 269    ------------------------------
 270    -- Get_Back_End_Config_File --
 271    ------------------------------
 272
 273    function Get_Back_End_Config_File return String_Ptr is
 274
 275       function Exec_Name return String;
 276       --  Return name of the current executable (from argv[0])
 277
 278       function Get_Target_File (Dir : String) return String_Ptr;
 279       --  Return Dir & "target.atp" if found, null otherwise
 280
 281       ---------------
 282       -- Exec_Name --
 283       ---------------
 284
 285       function Exec_Name return String is
 286          type Arg_Array is array (Nat) of Big_String_Ptr;
 287          type Arg_Array_Ptr is access all Arg_Array;
 288
 289          gnat_argv : Arg_Array_Ptr;
 290          pragma Import (C, gnat_argv);
 291
 292       begin
 293          for J in 1 .. Natural'Last loop
 294             if gnat_argv (0) (J) = ASCII.NUL then
 295                return gnat_argv (0) (1 .. J - 1);
 296             end if;
 297          end loop;
 298
 299          raise Program_Error;
 300       end Exec_Name;
 301
 302       ---------------------
 303       -- Get_Target_File --
 304       ---------------------
 305
 306       function Get_Target_File (Dir : String) return String_Ptr is
 307          F : constant String := Dir & "target.atp";
 308       begin
 309          if Is_Regular_File (F) then
 310             return new String'(F);
 311          else
 312             return null;
 313          end if;
 314       end Get_Target_File;
 315
 316       Exec : constant String := Exec_Name;
 317
 318    --  Start of processing for Get_Back_End_Config_File
 319
 320    begin
 321       if Is_Absolute_Path (Exec) then
 322          return Get_Target_File (Dir_Name (Exec));
 323       else
 324          return Get_Target_File (Dir_Name (Locate_Exec_On_Path (Exec).all));
 325       end if;
 326    end Get_Back_End_Config_File;
 327
 328 end Get_Targ;