1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2021, Free Software Foundation, Inc. --
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. --
21 ------------------------------------------------------------------------------
23 -- Version shared by various Ada based back-ends (e.g. gnat2scil, gnat2why)
25 with System
.OS_Lib
; use System
.OS_Lib
;
27 with GNAT
.Directory_Operations
; use GNAT
.Directory_Operations
;
29 package body Get_Targ
is
31 -----------------------
32 -- Get_Bits_Per_Unit --
33 -----------------------
35 function Get_Bits_Per_Unit
return Pos
is
38 end Get_Bits_Per_Unit
;
40 -----------------------
41 -- Get_Bits_Per_Word --
42 -----------------------
44 function Get_Bits_Per_Word
return Pos
is
47 end Get_Bits_Per_Word
;
53 function Get_Char_Size
return Pos
is
58 ----------------------
59 -- Get_Wchar_T_Size --
60 ----------------------
62 function Get_Wchar_T_Size
return Pos
is
71 function Get_Short_Size
return Pos
is
80 function Get_Int_Size
return Pos
is
89 function Get_Long_Size
return Pos
is
94 ------------------------
95 -- Get_Long_Long_Size --
96 ------------------------
98 function Get_Long_Long_Size
return Pos
is
101 end Get_Long_Long_Size
;
103 -----------------------------
104 -- Get_Long_Long_Long_Size --
105 -----------------------------
107 function Get_Long_Long_Long_Size
return Pos
is
110 end Get_Long_Long_Long_Size
;
112 ----------------------
113 -- Get_Pointer_Size --
114 ----------------------
116 function Get_Pointer_Size
return Pos
is
119 end Get_Pointer_Size
;
121 ---------------------------
122 -- Get_Maximum_Alignment --
123 ---------------------------
125 function Get_Maximum_Alignment
return Pos
is
128 end Get_Maximum_Alignment
;
130 ------------------------
131 -- Get_Float_Words_BE --
132 ------------------------
134 function Get_Float_Words_BE
return Nat
is
137 end Get_Float_Words_BE
;
143 function Get_Words_BE
return Nat
is
152 function Get_Bytes_BE
return Nat
is
161 function Get_Bits_BE
return Nat
is
166 ---------------------
167 -- Get_Short_Enums --
168 ---------------------
170 function Get_Short_Enums
return Int
is
175 --------------------------
176 -- Get_Strict_Alignment --
177 --------------------------
179 function Get_Strict_Alignment
return Nat
is
182 end Get_Strict_Alignment
;
184 ------------------------------------
185 -- Get_System_Allocator_Alignment --
186 ------------------------------------
188 function Get_System_Allocator_Alignment
return Nat
is
191 end Get_System_Allocator_Alignment
;
193 --------------------------------
194 -- Get_Double_Float_Alignment --
195 --------------------------------
197 function Get_Double_Float_Alignment
return Nat
is
200 end Get_Double_Float_Alignment
;
202 ---------------------------------
203 -- Get_Double_Scalar_Alignment --
204 ---------------------------------
206 function Get_Double_Scalar_Alignment
return Nat
is
209 end Get_Double_Scalar_Alignment
;
211 -----------------------------
212 -- Get_Max_Unaligned_Field --
213 -----------------------------
215 function Get_Max_Unaligned_Field
return Pos
is
217 return 64; -- Can be different on some targets
218 end Get_Max_Unaligned_Field
;
220 -----------------------------
221 -- Register_Back_End_Types --
222 -----------------------------
224 procedure Register_Back_End_Types
(Call_Back
: Register_Type_Proc
) is
225 Float_Str
: C_String
:= (others => ASCII
.NUL
);
226 Double_Str
: C_String
:= (others => ASCII
.NUL
);
229 Float_Str
(Float_Str
'First .. Float_Str
'First + 4) := "float";
231 (C_Name
=> Float_Str
, Digs
=> 6, Complex
=> False, Count
=> 0,
232 Float_Rep
=> IEEE_Binary
,
233 Precision
=> 32, Size
=> 32, Alignment
=> 32);
235 Double_Str
(Double_Str
'First .. Double_Str
'First + 5) := "double";
237 (C_Name
=> Double_Str
,
241 Float_Rep
=> IEEE_Binary
,
245 end Register_Back_End_Types
;
247 ------------------------------
248 -- Get_Back_End_Config_File --
249 ------------------------------
251 function Get_Back_End_Config_File
return String_Ptr
is
253 function Exec_Name
return String;
254 -- Return name of the current executable (from argv[0])
256 function Get_Target_File
(Dir
: String) return String_Ptr
;
257 -- Return Dir & "target.atp" if found, null otherwise
263 function Exec_Name
return String is
264 type Arg_Array
is array (Nat
) of Big_String_Ptr
;
265 type Arg_Array_Ptr
is access all Arg_Array
;
267 gnat_argv
: Arg_Array_Ptr
;
268 pragma Import
(C
, gnat_argv
);
271 for J
in 1 .. Natural'Last loop
272 if gnat_argv
(0) (J
) = ASCII
.NUL
then
273 return gnat_argv
(0) (1 .. J
- 1);
280 ---------------------
281 -- Get_Target_File --
282 ---------------------
284 function Get_Target_File
(Dir
: String) return String_Ptr
is
285 F
: constant String := Dir
& "target.atp";
287 if Is_Regular_File
(F
) then
288 return new String'(F);
294 Exec : constant String := Exec_Name;
296 -- Start of processing for Get_Back_End_Config_File
299 if Is_Absolute_Path (Exec) then
300 return Get_Target_File (Dir_Name (Exec));
302 return Get_Target_File (Dir_Name (Locate_Exec_On_Path (Exec).all));
304 end Get_Back_End_Config_File;