gcc/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-2013, 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 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 package body Get_Targ is
  27
  28    --  Functions returning individual runtime. For the standard (GCC) back
  29    --  end these come from C interface functions (one for each value).
  30
  31    -----------------------
  32    -- Get_Bits_Per_Unit --
  33    -----------------------
  34
  35    function Get_Bits_Per_Unit return Pos is
  36       function C_Get_Bits_Per_Unit return Pos;
  37       pragma Import (C, C_Get_Bits_Per_Unit,
  38                         "get_target_bits_per_unit");
  39    begin
  40       return C_Get_Bits_Per_Unit;
  41    end Get_Bits_Per_Unit;
  42
  43    -----------------------
  44    -- Get_Bits_Per_Word --
  45    -----------------------
  46
  47    function Get_Bits_Per_Word return Pos is
  48       function C_Get_Bits_Per_Word return Pos;
  49       pragma Import (C, C_Get_Bits_Per_Word,
  50                         "get_target_bits_per_word");
  51    begin
  52       return C_Get_Bits_Per_Word;
  53    end Get_Bits_Per_Word;
  54
  55    -------------------
  56    -- Get_Char_Size --
  57    -------------------
  58
  59    function Get_Char_Size return Pos is
  60       function C_Get_Char_Size return Pos;
  61       pragma Import (C, C_Get_Char_Size,
  62                         "get_target_char_size");
  63    begin
  64       return C_Get_Char_Size;
  65    end Get_Char_Size;
  66
  67    ----------------------
  68    -- Get_Wchar_T_Size --
  69    ----------------------
  70
  71    function Get_Wchar_T_Size return Pos is
  72       function C_Get_Wchar_T_Size return Pos;
  73       pragma Import (C, C_Get_Wchar_T_Size,
  74                         "get_target_wchar_t_size");
  75    begin
  76       return C_Get_Wchar_T_Size;
  77    end Get_Wchar_T_Size;
  78
  79    --------------------
  80    -- Get_Short_Size --
  81    --------------------
  82
  83    function Get_Short_Size return Pos is
  84       function C_Get_Short_Size return Pos;
  85       pragma Import (C, C_Get_Short_Size,
  86                         "get_target_short_size");
  87    begin
  88       return C_Get_Short_Size;
  89    end Get_Short_Size;
  90
  91    ------------------
  92    -- Get_Int_Size --
  93    ------------------
  94
  95    function Get_Int_Size return Pos is
  96       function C_Get_Int_Size return Pos;
  97       pragma Import (C, C_Get_Int_Size,
  98                         "get_target_int_size");
  99    begin
 100       return C_Get_Int_Size;
 101    end Get_Int_Size;
 102
 103    -------------------
 104    -- Get_Long_Size --
 105    -------------------
 106
 107    function Get_Long_Size return Pos is
 108       function C_Get_Long_Size return Pos;
 109       pragma Import (C, C_Get_Long_Size,
 110                         "get_target_long_size");
 111    begin
 112       return C_Get_Long_Size;
 113    end Get_Long_Size;
 114
 115    ------------------------
 116    -- Get_Long_Long_Size --
 117    ------------------------
 118
 119    function Get_Long_Long_Size return Pos is
 120       function C_Get_Long_Long_Size return Pos;
 121       pragma Import (C, C_Get_Long_Long_Size,
 122                         "get_target_long_long_size");
 123    begin
 124       return C_Get_Long_Long_Size;
 125    end Get_Long_Long_Size;
 126
 127    --------------------
 128    -- Get_Float_Size --
 129    --------------------
 130
 131    function Get_Float_Size return Pos is
 132       function C_Get_Float_Size return Pos;
 133       pragma Import (C, C_Get_Float_Size,
 134                         "get_target_float_size");
 135    begin
 136       return C_Get_Float_Size;
 137    end Get_Float_Size;
 138
 139    ---------------------
 140    -- Get_Double_Size --
 141    ---------------------
 142
 143    function Get_Double_Size return Pos is
 144       function C_Get_Double_Size return Pos;
 145       pragma Import (C, C_Get_Double_Size,
 146                         "get_target_double_size");
 147    begin
 148       return C_Get_Double_Size;
 149    end Get_Double_Size;
 150
 151    --------------------------
 152    -- Get_Long_Double_Size --
 153    --------------------------
 154
 155    function Get_Long_Double_Size return Pos is
 156       function C_Get_Long_Double_Size return Pos;
 157       pragma Import (C, C_Get_Long_Double_Size,
 158                         "get_target_long_double_size");
 159    begin
 160       return C_Get_Long_Double_Size;
 161    end Get_Long_Double_Size;
 162
 163    ----------------------
 164    -- Get_Pointer_Size --
 165    ----------------------
 166
 167    function Get_Pointer_Size return Pos is
 168       function C_Get_Pointer_Size return Pos;
 169       pragma Import (C, C_Get_Pointer_Size,
 170                         "get_target_pointer_size");
 171    begin
 172       return C_Get_Pointer_Size;
 173    end Get_Pointer_Size;
 174
 175    ---------------------------
 176    -- Get_Maximum_Alignment --
 177    ---------------------------
 178
 179    function Get_Maximum_Alignment return Pos is
 180       function C_Get_Maximum_Alignment return Pos;
 181       pragma Import (C, C_Get_Maximum_Alignment,
 182                         "get_target_maximum_alignment");
 183    begin
 184       return C_Get_Maximum_Alignment;
 185    end Get_Maximum_Alignment;
 186
 187    ------------------------
 188    -- Get_Float_Words_BE --
 189    ------------------------
 190
 191    function Get_Float_Words_BE return Nat is
 192       function C_Get_Float_Words_BE return Nat;
 193       pragma Import (C, C_Get_Float_Words_BE,
 194                         "get_float_words_be");
 195    begin
 196       return C_Get_Float_Words_BE;
 197    end Get_Float_Words_BE;
 198
 199    ------------------
 200    -- Get_Words_BE --
 201    ------------------
 202
 203    function Get_Words_BE return Nat is
 204       function C_Get_Words_BE return Nat;
 205       pragma Import (C, C_Get_Words_BE,
 206                         "get_words_be");
 207    begin
 208       return C_Get_Words_BE;
 209    end Get_Words_BE;
 210
 211    ------------------
 212    -- Get_Bytes_BE --
 213    ------------------
 214
 215    function Get_Bytes_BE return Nat is
 216       function C_Get_Bytes_BE return Nat;
 217       pragma Import (C, C_Get_Bytes_BE,
 218                         "get_bytes_be");
 219    begin
 220       return C_Get_Bytes_BE;
 221    end Get_Bytes_BE;
 222
 223    -----------------
 224    -- Get_Bits_BE --
 225    -----------------
 226
 227    function Get_Bits_BE return Nat is
 228       function C_Get_Bits_BE return Nat;
 229       pragma Import (C, C_Get_Bits_BE,
 230                         "get_bits_be");
 231    begin
 232       return C_Get_Bits_BE;
 233    end Get_Bits_BE;
 234
 235    --------------------------
 236    -- Get_Strict_Alignment --
 237    --------------------------
 238
 239    function Get_Strict_Alignment return Nat is
 240       function C_Get_Strict_Alignment return Nat;
 241       pragma Import (C, C_Get_Strict_Alignment,
 242                         "get_target_strict_alignment");
 243    begin
 244       return C_Get_Strict_Alignment;
 245    end Get_Strict_Alignment;
 246
 247    ------------------------------------
 248    -- Get_System_Allocator_Alignment --
 249    ------------------------------------
 250
 251    function Get_System_Allocator_Alignment return Nat is
 252       function C_Get_System_Allocator_Alignment return Nat;
 253       pragma Import (C, C_Get_System_Allocator_Alignment,
 254                         "get_target_system_allocator_alignment");
 255    begin
 256       return C_Get_System_Allocator_Alignment;
 257    end Get_System_Allocator_Alignment;
 258
 259    --------------------------------
 260    -- Get_Double_Float_Alignment --
 261    --------------------------------
 262
 263    function Get_Double_Float_Alignment return Nat is
 264       function C_Get_Double_Float_Alignment return Nat;
 265       pragma Import (C, C_Get_Double_Float_Alignment,
 266                         "get_target_double_float_alignment");
 267    begin
 268       return C_Get_Double_Float_Alignment;
 269    end Get_Double_Float_Alignment;
 270
 271    ---------------------------------
 272    -- Get_Double_Scalar_Alignment --
 273    ---------------------------------
 274
 275    function Get_Double_Scalar_Alignment return Nat is
 276       function C_Get_Double_Scalar_Alignment return Nat;
 277       pragma Import (C, C_Get_Double_Scalar_Alignment,
 278                         "get_target_double_scalar_alignment");
 279    begin
 280       return C_Get_Double_Scalar_Alignment;
 281    end Get_Double_Scalar_Alignment;
 282
 283    ----------------------
 284    -- Digits_From_Size --
 285    ----------------------
 286
 287    function Digits_From_Size (Size : Pos) return Pos is
 288    begin
 289       if    Size =  32 then
 290          return  6;
 291       elsif Size =  48 then
 292          return  9;
 293       elsif Size =  64 then
 294          return 15;
 295       elsif Size =  96 then
 296          return 18;
 297       elsif Size = 128 then
 298          return 18;
 299       else
 300          raise Program_Error;
 301       end if;
 302    end Digits_From_Size;
 303
 304    -----------------------------
 305    -- Get_Max_Unaligned_Field --
 306    -----------------------------
 307
 308    function Get_Max_Unaligned_Field return Pos is
 309    begin
 310       return 64;  -- Can be different on some targets (e.g., AAMP)
 311    end Get_Max_Unaligned_Field;
 312
 313    -----------------------------
 314    -- Register_Back_End_Types --
 315    -----------------------------
 316
 317    procedure Register_Back_End_Types (Call_Back : Register_Type_Proc) is
 318       procedure Enumerate_Modes (Call_Back : Register_Type_Proc);
 319       pragma Import (C, Enumerate_Modes, "enumerate_modes");
 320    begin
 321       Enumerate_Modes (Call_Back);
 322    end Register_Back_End_Types;
 323
 324    ---------------------
 325    -- Width_From_Size --
 326    ---------------------
 327
 328    function Width_From_Size  (Size : Pos) return Pos is
 329    begin
 330       if    Size =  8 then
 331          return  4;
 332       elsif Size = 16 then
 333          return  6;
 334       elsif Size = 32 then
 335          return 11;
 336       elsif Size = 64 then
 337          return 21;
 338       else
 339          raise Program_Error;
 340       end if;
 341    end Width_From_Size;
 342
 343 end Get_Targ;