1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
10 -- Copyright (C) 1996-2001 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- Extensive contributions were provided by Ada Core Technologies Inc. --
26 ------------------------------------------------------------------------------
28 with Atree
; use Atree
;
29 with Einfo
; use Einfo
;
30 with Errout
; use Errout
;
31 with Fname
; use Fname
;
33 with Namet
; use Namet
;
34 with Nlists
; use Nlists
;
35 with Nmake
; use Nmake
;
37 with Rtsfind
; use Rtsfind
;
38 with Sem_Eval
; use Sem_Eval
;
39 with Sem_Util
; use Sem_Util
;
40 with Sinfo
; use Sinfo
;
41 with Stringt
; use Stringt
;
42 with Tbuild
; use Tbuild
;
44 package body Exp_Code
is
46 -----------------------
47 -- Local_Subprograms --
48 -----------------------
50 function Asm_Constraint
(Operand_Var
: Node_Id
) return Node_Id
;
51 -- Common processing for Asm_Input_Constraint and Asm_Output_Constraint.
52 -- Obtains the constraint argument from the global operand variable
53 -- Operand_Var, which must be non-Empty.
55 function Asm_Operand
(Operand_Var
: Node_Id
) return Node_Id
;
56 -- Common processing for Asm_Input_Value and Asm_Output_Variable. Obtains
57 -- the value/variable argument from Operand_Var, the global operand
58 -- variable. Returns Empty if no operand available.
60 function Get_String_Node
(S
: Node_Id
) return Node_Id
;
61 -- Given S, a static expression node of type String, returns the
62 -- string literal node. This is needed to deal with the use of constants
63 -- for these expressions, which is perfectly permissible.
65 procedure Next_Asm_Operand
(Operand_Var
: in out Node_Id
);
66 -- Common processing for Next_Asm_Input and Next_Asm_Output, updates
67 -- the value of the global operand variable Operand_Var appropriately.
69 procedure Setup_Asm_IO_Args
(Arg
: Node_Id
; Operand_Var
: out Node_Id
);
70 -- Common processing for Setup_Asm_Inputs and Setup_Asm_Outputs. Arg
71 -- is the actual parameter from the call, and Operand_Var is the global
72 -- operand variable to be initialized to the first operand.
74 ----------------------
75 -- Global Variables --
76 ----------------------
78 Current_Input_Operand
: Node_Id
:= Empty
;
79 -- Points to current Asm_Input_Operand attribute reference. Initialized
80 -- by Setup_Asm_Inputs, updated by Next_Asm_Input, and referenced by
81 -- Asm_Input_Constraint and Asm_Input_Value.
83 Current_Output_Operand
: Node_Id
:= Empty
;
84 -- Points to current Asm_Output_Operand attribute reference. Initialized
85 -- by Setup_Asm_Outputs, updated by Next_Asm_Output, and referenced by
86 -- Asm_Output_Constraint and Asm_Output_Variable.
92 function Asm_Constraint
(Operand_Var
: Node_Id
) return Node_Id
is
94 pragma Assert
(Present
(Operand_Var
));
95 return Get_String_Node
(First
(Expressions
(Operand_Var
)));
98 --------------------------
99 -- Asm_Input_Constraint --
100 --------------------------
102 -- Note: error checking on Asm_Input attribute done in Sem_Attr
104 function Asm_Input_Constraint
return Node_Id
is
106 return Get_String_Node
(Asm_Constraint
(Current_Input_Operand
));
107 end Asm_Input_Constraint
;
109 ---------------------
110 -- Asm_Input_Value --
111 ---------------------
113 -- Note: error checking on Asm_Input attribute done in Sem_Attr
115 function Asm_Input_Value
return Node_Id
is
117 return Asm_Operand
(Current_Input_Operand
);
124 function Asm_Operand
(Operand_Var
: Node_Id
) return Node_Id
is
126 if No
(Operand_Var
) then
129 return Next
(First
(Expressions
(Operand_Var
)));
133 ---------------------------
134 -- Asm_Output_Constraint --
135 ---------------------------
137 -- Note: error checking on Asm_Output attribute done in Sem_Attr
139 function Asm_Output_Constraint
return Node_Id
is
141 return Asm_Constraint
(Current_Output_Operand
);
142 end Asm_Output_Constraint
;
144 -------------------------
145 -- Asm_Output_Variable --
146 -------------------------
148 -- Note: error checking on Asm_Output attribute done in Sem_Attr
150 function Asm_Output_Variable
return Node_Id
is
152 return Asm_Operand
(Current_Output_Operand
);
153 end Asm_Output_Variable
;
159 function Asm_Template
(N
: Node_Id
) return Node_Id
is
160 Call
: constant Node_Id
:= Expression
(Expression
(N
));
161 Temp
: constant Node_Id
:= First_Actual
(Call
);
164 -- Require static expression for template. We also allow a string
165 -- literal (this is useful for Ada 83 mode where string expressions
166 -- are never static).
168 if Is_OK_Static_Expression
(Temp
)
169 or else (Ada_83
and then Nkind
(Temp
) = N_String_Literal
)
171 return Get_String_Node
(Temp
);
174 Error_Msg_N
("asm template argument is not static", Temp
);
179 ----------------------
180 -- Clobber_Get_Next --
181 ----------------------
183 Clobber_Node
: Node_Id
;
184 -- String literal node for clobber string. Initialized by Clobber_Setup,
185 -- and not modified by Clobber_Get_Next. Empty if clobber string was in
186 -- error (resulting in no clobber arguments being returned).
189 -- Pointer to current character of string. Initialized to 1 by the call
190 -- to Clobber_Setup, and then updated by Clobber_Get_Next.
192 function Clobber_Get_Next
return Address
is
193 Str
: constant String_Id
:= Strval
(Clobber_Node
);
194 Len
: constant Nat
:= String_Length
(Str
);
198 if No
(Clobber_Node
) then
202 -- Skip spaces and commas before next register name
205 -- Return null string if no more names
207 if Clobber_Ptr
> Len
then
211 C
:= Get_Character
(Get_String_Char
(Str
, Clobber_Ptr
));
212 exit when C
/= ',' and then C
/= ' ';
213 Clobber_Ptr
:= Clobber_Ptr
+ 1;
216 -- Acquire next register name
220 Name_Len
:= Name_Len
+ 1;
221 Name_Buffer
(Name_Len
) := C
;
222 Clobber_Ptr
:= Clobber_Ptr
+ 1;
223 exit when Clobber_Ptr
> Len
;
224 C
:= Get_Character
(Get_String_Char
(Str
, Clobber_Ptr
));
225 exit when C
= ',' or else C
= ' ';
228 Name_Buffer
(Name_Len
+ 1) := ASCII
.NUL
;
229 return Name_Buffer
'Address;
231 end Clobber_Get_Next
;
237 procedure Clobber_Setup
(N
: Node_Id
) is
238 Call
: constant Node_Id
:= Expression
(Expression
(N
));
239 Clob
: constant Node_Id
:= Next_Actual
(
242 First_Actual
(Call
))));
245 if not Is_OK_Static_Expression
(Clob
) then
246 Error_Msg_N
("asm clobber argument is not static", Clob
);
247 Clobber_Node
:= Empty
;
250 Clobber_Node
:= Get_String_Node
(Clob
);
255 ---------------------
256 -- Expand_Asm_Call --
257 ---------------------
259 procedure Expand_Asm_Call
(N
: Node_Id
) is
260 Loc
: constant Source_Ptr
:= Sloc
(N
);
262 procedure Check_IO_Operand
(N
: Node_Id
);
263 -- Check for incorrect input or output operand
265 procedure Check_IO_Operand
(N
: Node_Id
) is
269 -- The only identifier allows is No_xxput_Operands. Since we
270 -- know the type is right, it is sufficient to see if the
271 -- referenced entity is in a runtime routine.
273 if Nkind
(N
) = N_Identifier
275 Is_Predefined_File_Name
(Unit_File_Name
276 (Get_Source_Unit
(Entity
(N
))))
280 -- An attribute reference is fine, again the analysis reasonably
281 -- guarantees that the attribute must be subtype'Asm_??put.
283 elsif Nkind
(N
) = N_Attribute_Reference
then
286 -- The only other allowed form is an array aggregate in which
287 -- all the entries are positional and are attribute references.
289 elsif Nkind
(N
) = N_Aggregate
then
290 if Present
(Component_Associations
(N
)) then
291 Err
:= First
(Component_Associations
(N
));
293 elsif Present
(Expressions
(N
)) then
294 Err
:= First
(Expressions
(N
));
295 while Present
(Err
) loop
296 exit when Nkind
(Err
) /= N_Attribute_Reference
;
306 -- If we fall through, Err is pointing to the bad node
308 Error_Msg_N
("Asm operand has wrong form", Err
);
309 end Check_IO_Operand
;
311 -- Start of processing for Expand_Asm_Call
314 -- Check that the input and output operands have the right
315 -- form, as required by the documentation of the Asm feature:
317 -- OUTPUT_OPERAND_LIST ::=
318 -- No_Output_Operands
319 -- | OUTPUT_OPERAND_ATTRIBUTE
320 -- | (OUTPUT_OPERAND_ATTRIBUTE @{,OUTPUT_OPERAND_ATTRIBUTE@})
322 -- OUTPUT_OPERAND_ATTRIBUTE ::=
323 -- SUBTYPE_MARK'Asm_Output (static_string_EXPRESSION, NAME)
325 -- INPUT_OPERAND_LIST ::=
327 -- | INPUT_OPERAND_ATTRIBUTE
328 -- | (INPUT_OPERAND_ATTRIBUTE @{,INPUT_OPERAND_ATTRIBUTE@})
330 -- INPUT_OPERAND_ATTRIBUTE ::=
331 -- SUBTYPE_MARK'Asm_Input (static_string_EXPRESSION, EXPRESSION)
334 Arg_Output
: constant Node_Id
:= Next_Actual
(First_Actual
(N
));
335 Arg_Input
: constant Node_Id
:= Next_Actual
(Arg_Output
);
338 Check_IO_Operand
(Arg_Output
);
339 Check_IO_Operand
(Arg_Input
);
342 -- If we have the function call case, we are inside a code statement,
343 -- and the tree is already in the necessary form for gigi.
345 if Nkind
(N
) = N_Function_Call
then
348 -- For the procedure case, we convert the call into a code statement
351 pragma Assert
(Nkind
(N
) = N_Procedure_Call_Statement
);
353 -- Note: strictly we should change the procedure call to a function
354 -- call in the qualified expression, but since we are not going to
355 -- reanalyze (see below), and the interface subprograms in this
356 -- package don't care, we can leave it as a procedure call.
359 Make_Code_Statement
(Loc
,
361 Make_Qualified_Expression
(Loc
,
362 Subtype_Mark
=> New_Occurrence_Of
(RTE
(RE_Asm_Insn
), Loc
),
363 Expression
=> Relocate_Node
(N
))));
365 -- There is no need to reanalyze this node, it is completely analyzed
366 -- already, at least sufficiently for the purposes of the abstract
367 -- procedural interface defined in this package.
373 ---------------------
374 -- Get_String_Node --
375 ---------------------
377 function Get_String_Node
(S
: Node_Id
) return Node_Id
is
379 if Nkind
(S
) = N_String_Literal
then
383 pragma Assert
(Ekind
(Entity
(S
)) = E_Constant
);
384 return Get_String_Node
(Constant_Value
(Entity
(S
)));
388 ---------------------
389 -- Is_Asm_Volatile --
390 ---------------------
392 function Is_Asm_Volatile
(N
: Node_Id
) return Boolean is
393 Call
: constant Node_Id
:= Expression
(Expression
(N
));
394 Vol
: constant Node_Id
:=
399 First_Actual
(Call
)))));
402 if not Is_OK_Static_Expression
(Vol
) then
403 Error_Msg_N
("asm volatile argument is not static", Vol
);
407 return Is_True
(Expr_Value
(Vol
));
415 procedure Next_Asm_Input
is
417 Next_Asm_Operand
(Current_Input_Operand
);
420 ----------------------
421 -- Next_Asm_Operand --
422 ----------------------
424 procedure Next_Asm_Operand
(Operand_Var
: in out Node_Id
) is
426 pragma Assert
(Present
(Operand_Var
));
428 if Nkind
(Parent
(Operand_Var
)) = N_Aggregate
then
429 Operand_Var
:= Next
(Operand_Var
);
432 Operand_Var
:= Empty
;
434 end Next_Asm_Operand
;
436 ---------------------
437 -- Next_Asm_Output --
438 ---------------------
440 procedure Next_Asm_Output
is
442 Next_Asm_Operand
(Current_Output_Operand
);
445 ----------------------
446 -- Setup_Asm_Inputs --
447 ----------------------
449 procedure Setup_Asm_Inputs
(N
: Node_Id
) is
450 Call
: constant Node_Id
:= Expression
(Expression
(N
));
454 (Next_Actual
(Next_Actual
(First_Actual
(Call
))),
455 Current_Input_Operand
);
456 end Setup_Asm_Inputs
;
458 -----------------------
459 -- Setup_Asm_IO_Args --
460 -----------------------
462 procedure Setup_Asm_IO_Args
(Arg
: Node_Id
; Operand_Var
: out Node_Id
) is
464 -- Case of single argument
466 if Nkind
(Arg
) = N_Attribute_Reference
then
469 -- Case of list of arguments
471 elsif Nkind
(Arg
) = N_Aggregate
then
472 if Expressions
(Arg
) = No_List
then
473 Operand_Var
:= Empty
;
475 Operand_Var
:= First
(Expressions
(Arg
));
478 -- Otherwise must be default (no operands) case
481 Operand_Var
:= Empty
;
483 end Setup_Asm_IO_Args
;
485 -----------------------
486 -- Setup_Asm_Outputs --
487 -----------------------
489 procedure Setup_Asm_Outputs
(N
: Node_Id
) is
490 Call
: constant Node_Id
:= Expression
(Expression
(N
));
494 (Next_Actual
(First_Actual
(Call
)),
495 Current_Output_Operand
);
496 end Setup_Asm_Outputs
;