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-2019, 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 25with System.OS_Lib; use System.OS_Lib; 26 27with GNAT.Directory_Operations; use GNAT.Directory_Operations; 28 29package 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 328end Get_Targ; 329