1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1996-2023, 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 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with Atree
; use Atree
;
27 with Einfo
; use Einfo
;
28 with Einfo
.Entities
; use Einfo
.Entities
;
29 with Einfo
.Utils
; use Einfo
.Utils
;
30 with Errout
; use Errout
;
32 with Namet
; use Namet
;
33 with Nlists
; use Nlists
;
34 with Nmake
; use Nmake
;
36 with Rtsfind
; use Rtsfind
;
37 with Sem_Aux
; use Sem_Aux
;
38 with Sem_Eval
; use Sem_Eval
;
39 with Sem_Util
; use Sem_Util
;
40 with Sem_Warn
; use Sem_Warn
;
41 with Sinfo
; use Sinfo
;
42 with Sinfo
.Nodes
; use Sinfo
.Nodes
;
43 with Sinfo
.Utils
; use Sinfo
.Utils
;
44 with Stringt
; use Stringt
;
45 with Tbuild
; use Tbuild
;
47 package body Exp_Code
is
49 -----------------------
50 -- Local_Subprograms --
51 -----------------------
53 function Asm_Constraint
(Operand_Var
: Node_Id
) return Node_Id
;
54 -- Common processing for Asm_Input_Constraint and Asm_Output_Constraint.
55 -- Obtains the constraint argument from the global operand variable
56 -- Operand_Var, which must be non-Empty.
58 function Asm_Operand
(Operand_Var
: Node_Id
) return Node_Id
;
59 -- Common processing for Asm_Input_Value and Asm_Output_Variable. Obtains
60 -- the value/variable argument from Operand_Var, the global operand
61 -- variable. Returns Empty if no operand available.
63 function Get_String_Node
(S
: Node_Id
) return Node_Id
;
64 -- Given S, a static expression node of type String, returns the
65 -- string literal node. This is needed to deal with the use of constants
66 -- for these expressions, which is perfectly permissible.
68 procedure Next_Asm_Operand
(Operand_Var
: in out Node_Id
);
69 -- Common processing for Next_Asm_Input and Next_Asm_Output, updates
70 -- the value of the global operand variable Operand_Var appropriately.
72 procedure Setup_Asm_IO_Args
(Arg
: Node_Id
; Operand_Var
: out Node_Id
);
73 -- Common processing for Setup_Asm_Inputs and Setup_Asm_Outputs. Arg
74 -- is the actual parameter from the call, and Operand_Var is the global
75 -- operand variable to be initialized to the first operand.
77 ----------------------
78 -- Global Variables --
79 ----------------------
81 Current_Input_Operand
: Node_Id
:= Empty
;
82 -- Points to current Asm_Input_Operand attribute reference. Initialized
83 -- by Setup_Asm_Inputs, updated by Next_Asm_Input, and referenced by
84 -- Asm_Input_Constraint and Asm_Input_Value.
86 Current_Output_Operand
: Node_Id
:= Empty
;
87 -- Points to current Asm_Output_Operand attribute reference. Initialized
88 -- by Setup_Asm_Outputs, updated by Next_Asm_Output, and referenced by
89 -- Asm_Output_Constraint and Asm_Output_Variable.
95 function Asm_Constraint
(Operand_Var
: Node_Id
) return Node_Id
is
97 pragma Assert
(Present
(Operand_Var
));
98 return Get_String_Node
(First
(Expressions
(Operand_Var
)));
101 --------------------------
102 -- Asm_Input_Constraint --
103 --------------------------
105 -- Note: error checking on Asm_Input attribute done in Sem_Attr
107 function Asm_Input_Constraint
return Node_Id
is
109 return Get_String_Node
(Asm_Constraint
(Current_Input_Operand
));
110 end Asm_Input_Constraint
;
112 ---------------------
113 -- Asm_Input_Value --
114 ---------------------
116 -- Note: error checking on Asm_Input attribute done in Sem_Attr
118 function Asm_Input_Value
return Node_Id
is
120 return Asm_Operand
(Current_Input_Operand
);
127 function Asm_Operand
(Operand_Var
: Node_Id
) return Node_Id
is
129 if No
(Operand_Var
) then
131 elsif Error_Posted
(Operand_Var
) then
134 return Next
(First
(Expressions
(Operand_Var
)));
138 ---------------------------
139 -- Asm_Output_Constraint --
140 ---------------------------
142 -- Note: error checking on Asm_Output attribute done in Sem_Attr
144 function Asm_Output_Constraint
return Node_Id
is
146 return Asm_Constraint
(Current_Output_Operand
);
147 end Asm_Output_Constraint
;
149 -------------------------
150 -- Asm_Output_Variable --
151 -------------------------
153 -- Note: error checking on Asm_Output attribute done in Sem_Attr
155 function Asm_Output_Variable
return Node_Id
is
157 return Asm_Operand
(Current_Output_Operand
);
158 end Asm_Output_Variable
;
164 function Asm_Template
(N
: Node_Id
) return Node_Id
is
165 Call
: constant Node_Id
:= Expression
(Expression
(N
));
166 Temp
: constant Node_Id
:= First_Actual
(Call
);
169 -- Require static expression for template. We also allow a string
170 -- literal (this is useful for Ada 83 mode where string expressions
171 -- are never static).
173 if Is_OK_Static_Expression
(Temp
)
174 or else (Ada_Version
= Ada_83
175 and then Nkind
(Temp
) = N_String_Literal
)
177 return Get_String_Node
(Temp
);
180 Flag_Non_Static_Expr
("asm template argument is not static!", Temp
);
185 ----------------------
186 -- Clobber_Get_Next --
187 ----------------------
189 Clobber_Node
: Node_Id
;
190 -- String literal node for clobber string. Initialized by Clobber_Setup,
191 -- and not modified by Clobber_Get_Next. Empty if clobber string was in
192 -- error (resulting in no clobber arguments being returned).
195 -- Pointer to current character of string. Initialized to 1 by the call
196 -- to Clobber_Setup, and then updated by Clobber_Get_Next.
198 function Clobber_Get_Next
return Address
is
199 Str
: constant String_Id
:= Strval
(Clobber_Node
);
200 Len
: constant Nat
:= String_Length
(Str
);
204 if No
(Clobber_Node
) then
208 -- Skip spaces and commas before next register name
211 -- Return null string if no more names
213 if Clobber_Ptr
> Len
then
217 C
:= Get_Character
(Get_String_Char
(Str
, Clobber_Ptr
));
218 exit when C
/= ',' and then C
/= ' ';
219 Clobber_Ptr
:= Clobber_Ptr
+ 1;
222 -- Acquire next register name
226 Add_Char_To_Name_Buffer
(C
);
227 Clobber_Ptr
:= Clobber_Ptr
+ 1;
228 exit when Clobber_Ptr
> Len
;
229 C
:= Get_Character
(Get_String_Char
(Str
, Clobber_Ptr
));
230 exit when C
= ',' or else C
= ' ';
233 Name_Buffer
(Name_Len
+ 1) := ASCII
.NUL
;
234 return Name_Buffer
'Address;
235 end Clobber_Get_Next
;
241 procedure Clobber_Setup
(N
: Node_Id
) is
242 Call
: constant Node_Id
:= Expression
(Expression
(N
));
243 Clob
: constant Node_Id
:= Next_Actual
(
246 First_Actual
(Call
))));
248 if not Is_OK_Static_Expression
(Clob
) then
249 Flag_Non_Static_Expr
("asm clobber argument is not static!", Clob
);
250 Clobber_Node
:= Empty
;
252 Clobber_Node
:= Get_String_Node
(Clob
);
257 ---------------------
258 -- Expand_Asm_Call --
259 ---------------------
261 procedure Expand_Asm_Call
(N
: Node_Id
) is
262 Loc
: constant Source_Ptr
:= Sloc
(N
);
264 procedure Check_IO_Operand
(N
: Node_Id
);
265 -- Check for incorrect input or output operand
267 ----------------------
268 -- Check_IO_Operand --
269 ----------------------
271 procedure Check_IO_Operand
(N
: Node_Id
) is
275 -- The only identifier allowed is No_xxput_Operands. Since we
276 -- know the type is right, it is sufficient to see if the
277 -- referenced entity is in a runtime routine.
279 if Is_Entity_Name
(N
)
280 and then Is_Predefined_Unit
(Get_Source_Unit
(Entity
(N
)))
284 -- An attribute reference is fine, again the analysis reasonably
285 -- guarantees that the attribute must be subtype'Asm_??put.
287 elsif Nkind
(N
) = N_Attribute_Reference
then
290 -- The only other allowed form is an array aggregate in which
291 -- all the entries are positional and are attribute references.
293 elsif Nkind
(N
) = N_Aggregate
then
294 if Present
(Component_Associations
(N
)) then
295 Err
:= First
(Component_Associations
(N
));
297 elsif Present
(Expressions
(N
)) then
298 Err
:= First
(Expressions
(N
));
299 while Present
(Err
) loop
300 exit when Nkind
(Err
) /= N_Attribute_Reference
;
310 -- If we fall through, Err is pointing to the bad node
312 Error_Msg_N
("Asm operand has wrong form", Err
);
313 end Check_IO_Operand
;
315 -- Start of processing for Expand_Asm_Call
318 -- Check that the input and output operands have the right
319 -- form, as required by the documentation of the Asm feature:
321 -- OUTPUT_OPERAND_LIST ::=
322 -- No_Output_Operands
323 -- | OUTPUT_OPERAND_ATTRIBUTE
324 -- | (OUTPUT_OPERAND_ATTRIBUTE @{,OUTPUT_OPERAND_ATTRIBUTE@})
326 -- OUTPUT_OPERAND_ATTRIBUTE ::=
327 -- SUBTYPE_MARK'Asm_Output (static_string_EXPRESSION, NAME)
329 -- INPUT_OPERAND_LIST ::=
331 -- | INPUT_OPERAND_ATTRIBUTE
332 -- | (INPUT_OPERAND_ATTRIBUTE @{,INPUT_OPERAND_ATTRIBUTE@})
334 -- INPUT_OPERAND_ATTRIBUTE ::=
335 -- SUBTYPE_MARK'Asm_Input (static_string_EXPRESSION, EXPRESSION)
338 Arg_Output
: constant Node_Id
:= Next_Actual
(First_Actual
(N
));
339 Arg_Input
: constant Node_Id
:= Next_Actual
(Arg_Output
);
341 Check_IO_Operand
(Arg_Output
);
342 Check_IO_Operand
(Arg_Input
);
345 -- If we have the function call case, we are inside a code statement,
346 -- and the tree is already in the necessary form for gigi.
348 if Nkind
(N
) = N_Function_Call
then
351 -- For the procedure case, we convert the call into a code statement
354 pragma Assert
(Nkind
(N
) = N_Procedure_Call_Statement
);
356 -- Note: strictly we should change the procedure call to a function
357 -- call in the qualified expression, but since we are not going to
358 -- reanalyze (see below), and the interface subprograms in this
359 -- package don't care, we can leave it as a procedure call.
362 Make_Code_Statement
(Loc
,
364 Make_Qualified_Expression
(Loc
,
365 Subtype_Mark
=> New_Occurrence_Of
(RTE
(RE_Asm_Insn
), Loc
),
366 Expression
=> Relocate_Node
(N
))));
368 -- There is no need to reanalyze this node, it is completely analyzed
369 -- already, at least sufficiently for the purposes of the abstract
370 -- procedural interface defined in this package. Furthermore if we
371 -- let it go through the normal analysis, that would include some
372 -- inappropriate checks that apply only to explicit code statements
373 -- in the source, and not to calls to intrinsics.
376 Check_Code_Statement
(N
);
380 ---------------------
381 -- Get_String_Node --
382 ---------------------
384 function Get_String_Node
(S
: Node_Id
) return Node_Id
is
386 if Nkind
(S
) = N_String_Literal
then
389 pragma Assert
(Ekind
(Entity
(S
)) = E_Constant
);
390 return Get_String_Node
(Constant_Value
(Entity
(S
)));
394 ---------------------
395 -- Is_Asm_Volatile --
396 ---------------------
398 function Is_Asm_Volatile
(N
: Node_Id
) return Boolean is
399 Call
: constant Node_Id
:= Expression
(Expression
(N
));
400 Vol
: constant Node_Id
:=
405 First_Actual
(Call
)))));
407 if not Is_OK_Static_Expression
(Vol
) then
408 Flag_Non_Static_Expr
("asm volatile argument is not static!", Vol
);
411 return Is_True
(Expr_Value
(Vol
));
419 procedure Next_Asm_Input
is
421 Next_Asm_Operand
(Current_Input_Operand
);
424 ----------------------
425 -- Next_Asm_Operand --
426 ----------------------
428 procedure Next_Asm_Operand
(Operand_Var
: in out Node_Id
) is
430 pragma Assert
(Present
(Operand_Var
));
432 if Nkind
(Parent
(Operand_Var
)) = N_Aggregate
then
433 Operand_Var
:= Next
(Operand_Var
);
435 Operand_Var
:= Empty
;
437 end Next_Asm_Operand
;
439 ---------------------
440 -- Next_Asm_Output --
441 ---------------------
443 procedure Next_Asm_Output
is
445 Next_Asm_Operand
(Current_Output_Operand
);
448 ----------------------
449 -- Setup_Asm_Inputs --
450 ----------------------
452 procedure Setup_Asm_Inputs
(N
: Node_Id
) is
453 Call
: constant Node_Id
:= Expression
(Expression
(N
));
456 (Next_Actual
(Next_Actual
(First_Actual
(Call
))),
457 Current_Input_Operand
);
458 end Setup_Asm_Inputs
;
460 -----------------------
461 -- Setup_Asm_IO_Args --
462 -----------------------
464 procedure Setup_Asm_IO_Args
(Arg
: Node_Id
; Operand_Var
: out Node_Id
) is
466 -- Case of single argument
468 if Nkind
(Arg
) = N_Attribute_Reference
then
471 -- Case of list of arguments
473 elsif Nkind
(Arg
) = N_Aggregate
then
474 Operand_Var
:= First
(Expressions
(Arg
));
476 -- Otherwise must be default (no operands) case
479 Operand_Var
:= Empty
;
481 end Setup_Asm_IO_Args
;
483 -----------------------
484 -- Setup_Asm_Outputs --
485 -----------------------
487 procedure Setup_Asm_Outputs
(N
: Node_Id
) is
488 Call
: constant Node_Id
:= Expression
(Expression
(N
));
491 (Next_Actual
(First_Actual
(Call
)),
492 Current_Output_Operand
);
493 end Setup_Asm_Outputs
;