1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
11 -- Copyright (C) 1996-2001 Free Software Foundation, Inc. --
13 -- GNAT is free software; you can redistribute it and/or modify it under --
14 -- terms of the GNU General Public License as published by the Free Soft- --
15 -- ware Foundation; either version 2, or (at your option) any later ver- --
16 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
17 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
18 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
19 -- for more details. You should have received a copy of the GNU General --
20 -- Public License distributed with GNAT; see file COPYING. If not, write --
21 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
22 -- MA 02111-1307, USA. --
24 -- GNAT was originally developed by the GNAT team at New York University. --
25 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
27 ------------------------------------------------------------------------------
29 with Atree; use Atree;
30 with Einfo; use Einfo;
31 with Errout; use Errout;
32 with Fname; use Fname;
34 with Namet; use Namet;
35 with Nlists; use Nlists;
36 with Nmake; use Nmake;
38 with Rtsfind; use Rtsfind;
39 with Sem_Eval; use Sem_Eval;
40 with Sem_Util; use Sem_Util;
41 with Sinfo; use Sinfo;
42 with Stringt; use Stringt;
43 with Tbuild; use Tbuild;
45 package body Exp_Code is
47 -----------------------
48 -- Local_Subprograms --
49 -----------------------
51 function Asm_Constraint (Operand_Var : Node_Id) return Node_Id;
52 -- Common processing for Asm_Input_Constraint and Asm_Output_Constraint.
53 -- Obtains the constraint argument from the global operand variable
54 -- Operand_Var, which must be non-Empty.
56 function Asm_Operand (Operand_Var : Node_Id) return Node_Id;
57 -- Common processing for Asm_Input_Value and Asm_Output_Variable. Obtains
58 -- the value/variable argument from Operand_Var, the global operand
59 -- variable. Returns Empty if no operand available.
61 function Get_String_Node (S : Node_Id) return Node_Id;
62 -- Given S, a static expression node of type String, returns the
63 -- string literal node. This is needed to deal with the use of constants
64 -- for these expressions, which is perfectly permissible.
66 procedure Next_Asm_Operand (Operand_Var : in out Node_Id);
67 -- Common processing for Next_Asm_Input and Next_Asm_Output, updates
68 -- the value of the global operand variable Operand_Var appropriately.
70 procedure Setup_Asm_IO_Args (Arg : Node_Id; Operand_Var : out Node_Id);
71 -- Common processing for Setup_Asm_Inputs and Setup_Asm_Outputs. Arg
72 -- is the actual parameter from the call, and Operand_Var is the global
73 -- operand variable to be initialized to the first operand.
75 ----------------------
76 -- Global Variables --
77 ----------------------
79 Current_Input_Operand : Node_Id := Empty;
80 -- Points to current Asm_Input_Operand attribute reference. Initialized
81 -- by Setup_Asm_Inputs, updated by Next_Asm_Input, and referenced by
82 -- Asm_Input_Constraint and Asm_Input_Value.
84 Current_Output_Operand : Node_Id := Empty;
85 -- Points to current Asm_Output_Operand attribute reference. Initialized
86 -- by Setup_Asm_Outputs, updated by Next_Asm_Output, and referenced by
87 -- Asm_Output_Constraint and Asm_Output_Variable.
93 function Asm_Constraint (Operand_Var : Node_Id) return Node_Id is
95 pragma Assert (Present (Operand_Var));
96 return Get_String_Node (First (Expressions (Operand_Var)));
99 --------------------------
100 -- Asm_Input_Constraint --
101 --------------------------
103 -- Note: error checking on Asm_Input attribute done in Sem_Attr
105 function Asm_Input_Constraint return Node_Id is
107 return Get_String_Node (Asm_Constraint (Current_Input_Operand));
108 end Asm_Input_Constraint;
110 ---------------------
111 -- Asm_Input_Value --
112 ---------------------
114 -- Note: error checking on Asm_Input attribute done in Sem_Attr
116 function Asm_Input_Value return Node_Id is
118 return Asm_Operand (Current_Input_Operand);
125 function Asm_Operand (Operand_Var : Node_Id) return Node_Id is
127 if No (Operand_Var) then
130 return Next (First (Expressions (Operand_Var)));
134 ---------------------------
135 -- Asm_Output_Constraint --
136 ---------------------------
138 -- Note: error checking on Asm_Output attribute done in Sem_Attr
140 function Asm_Output_Constraint return Node_Id is
142 return Asm_Constraint (Current_Output_Operand);
143 end Asm_Output_Constraint;
145 -------------------------
146 -- Asm_Output_Variable --
147 -------------------------
149 -- Note: error checking on Asm_Output attribute done in Sem_Attr
151 function Asm_Output_Variable return Node_Id is
153 return Asm_Operand (Current_Output_Operand);
154 end Asm_Output_Variable;
160 function Asm_Template (N : Node_Id) return Node_Id is
161 Call : constant Node_Id := Expression (Expression (N));
162 Temp : constant Node_Id := First_Actual (Call);
165 -- Require static expression for template. We also allow a string
166 -- literal (this is useful for Ada 83 mode where string expressions
167 -- are never static).
169 if Is_OK_Static_Expression (Temp)
170 or else (Ada_83 and then Nkind (Temp) = N_String_Literal)
172 return Get_String_Node (Temp);
175 Error_Msg_N ("asm template argument is not static", Temp);
180 ----------------------
181 -- Clobber_Get_Next --
182 ----------------------
184 Clobber_Node : Node_Id;
185 -- String literal node for clobber string. Initialized by Clobber_Setup,
186 -- and not modified by Clobber_Get_Next. Empty if clobber string was in
187 -- error (resulting in no clobber arguments being returned).
190 -- Pointer to current character of string. Initialized to 1 by the call
191 -- to Clobber_Setup, and then updated by Clobber_Get_Next.
193 function Clobber_Get_Next return Address is
194 Str : constant String_Id := Strval (Clobber_Node);
195 Len : constant Nat := String_Length (Str);
199 if No (Clobber_Node) then
203 -- Skip spaces and commas before next register name
206 -- Return null string if no more names
208 if Clobber_Ptr > Len then
212 C := Get_Character (Get_String_Char (Str, Clobber_Ptr));
213 exit when C /= ',' and then C /= ' ';
214 Clobber_Ptr := Clobber_Ptr + 1;
217 -- Acquire next register name
221 Name_Len := Name_Len + 1;
222 Name_Buffer (Name_Len) := C;
223 Clobber_Ptr := Clobber_Ptr + 1;
224 exit when Clobber_Ptr > Len;
225 C := Get_Character (Get_String_Char (Str, Clobber_Ptr));
226 exit when C = ',' or else C = ' ';
229 Name_Buffer (Name_Len + 1) := ASCII.NUL;
230 return Name_Buffer'Address;
232 end Clobber_Get_Next;
238 procedure Clobber_Setup (N : Node_Id) is
239 Call : constant Node_Id := Expression (Expression (N));
240 Clob : constant Node_Id := Next_Actual (
243 First_Actual (Call))));
246 if not Is_OK_Static_Expression (Clob) then
247 Error_Msg_N ("asm clobber argument is not static", Clob);
248 Clobber_Node := Empty;
251 Clobber_Node := Get_String_Node (Clob);
256 ---------------------
257 -- Expand_Asm_Call --
258 ---------------------
260 procedure Expand_Asm_Call (N : Node_Id) is
261 Loc : constant Source_Ptr := Sloc (N);
263 procedure Check_IO_Operand (N : Node_Id);
264 -- Check for incorrect input or output operand
266 procedure Check_IO_Operand (N : Node_Id) is
270 -- The only identifier allows is No_xxput_Operands. Since we
271 -- know the type is right, it is sufficient to see if the
272 -- referenced entity is in a runtime routine.
274 if Nkind (N) = N_Identifier
276 Is_Predefined_File_Name (Unit_File_Name
277 (Get_Source_Unit (Entity (N))))
281 -- An attribute reference is fine, again the analysis reasonably
282 -- guarantees that the attribute must be subtype'Asm_??put.
284 elsif Nkind (N) = N_Attribute_Reference then
287 -- The only other allowed form is an array aggregate in which
288 -- all the entries are positional and are attribute references.
290 elsif Nkind (N) = N_Aggregate then
291 if Present (Component_Associations (N)) then
292 Err := First (Component_Associations (N));
294 elsif Present (Expressions (N)) then
295 Err := First (Expressions (N));
296 while Present (Err) loop
297 exit when Nkind (Err) /= N_Attribute_Reference;
307 -- If we fall through, Err is pointing to the bad node
309 Error_Msg_N ("Asm operand has wrong form", Err);
310 end Check_IO_Operand;
312 -- Start of processing for Expand_Asm_Call
315 -- Check that the input and output operands have the right
316 -- form, as required by the documentation of the Asm feature:
318 -- OUTPUT_OPERAND_LIST ::=
319 -- No_Output_Operands
320 -- | OUTPUT_OPERAND_ATTRIBUTE
321 -- | (OUTPUT_OPERAND_ATTRIBUTE @{,OUTPUT_OPERAND_ATTRIBUTE@})
323 -- OUTPUT_OPERAND_ATTRIBUTE ::=
324 -- SUBTYPE_MARK'Asm_Output (static_string_EXPRESSION, NAME)
326 -- INPUT_OPERAND_LIST ::=
328 -- | INPUT_OPERAND_ATTRIBUTE
329 -- | (INPUT_OPERAND_ATTRIBUTE @{,INPUT_OPERAND_ATTRIBUTE@})
331 -- INPUT_OPERAND_ATTRIBUTE ::=
332 -- SUBTYPE_MARK'Asm_Input (static_string_EXPRESSION, EXPRESSION)
335 Arg_Output : constant Node_Id := Next_Actual (First_Actual (N));
336 Arg_Input : constant Node_Id := Next_Actual (Arg_Output);
339 Check_IO_Operand (Arg_Output);
340 Check_IO_Operand (Arg_Input);
343 -- If we have the function call case, we are inside a code statement,
344 -- and the tree is already in the necessary form for gigi.
346 if Nkind (N) = N_Function_Call then
349 -- For the procedure case, we convert the call into a code statement
352 pragma Assert (Nkind (N) = N_Procedure_Call_Statement);
354 -- Note: strictly we should change the procedure call to a function
355 -- call in the qualified expression, but since we are not going to
356 -- reanalyze (see below), and the interface subprograms in this
357 -- package don't care, we can leave it as a procedure call.
360 Make_Code_Statement (Loc,
362 Make_Qualified_Expression (Loc,
363 Subtype_Mark => New_Occurrence_Of (RTE (RE_Asm_Insn), Loc),
364 Expression => Relocate_Node (N))));
366 -- There is no need to reanalyze this node, it is completely analyzed
367 -- already, at least sufficiently for the purposes of the abstract
368 -- procedural interface defined in this package.
374 ---------------------
375 -- Get_String_Node --
376 ---------------------
378 function Get_String_Node (S : Node_Id) return Node_Id is
380 if Nkind (S) = N_String_Literal then
384 pragma Assert (Ekind (Entity (S)) = E_Constant);
385 return Get_String_Node (Constant_Value (Entity (S)));
389 ---------------------
390 -- Is_Asm_Volatile --
391 ---------------------
393 function Is_Asm_Volatile (N : Node_Id) return Boolean is
394 Call : constant Node_Id := Expression (Expression (N));
395 Vol : constant Node_Id :=
400 First_Actual (Call)))));
403 if not Is_OK_Static_Expression (Vol) then
404 Error_Msg_N ("asm volatile argument is not static", Vol);
408 return Is_True (Expr_Value (Vol));
416 procedure Next_Asm_Input is
418 Next_Asm_Operand (Current_Input_Operand);
421 ----------------------
422 -- Next_Asm_Operand --
423 ----------------------
425 procedure Next_Asm_Operand (Operand_Var : in out Node_Id) is
427 pragma Assert (Present (Operand_Var));
429 if Nkind (Parent (Operand_Var)) = N_Aggregate then
430 Operand_Var := Next (Operand_Var);
433 Operand_Var := Empty;
435 end Next_Asm_Operand;
437 ---------------------
438 -- Next_Asm_Output --
439 ---------------------
441 procedure Next_Asm_Output is
443 Next_Asm_Operand (Current_Output_Operand);
446 ----------------------
447 -- Setup_Asm_Inputs --
448 ----------------------
450 procedure Setup_Asm_Inputs (N : Node_Id) is
451 Call : constant Node_Id := Expression (Expression (N));
455 (Next_Actual (Next_Actual (First_Actual (Call))),
456 Current_Input_Operand);
457 end Setup_Asm_Inputs;
459 -----------------------
460 -- Setup_Asm_IO_Args --
461 -----------------------
463 procedure Setup_Asm_IO_Args (Arg : Node_Id; Operand_Var : out Node_Id) is
465 -- Case of single argument
467 if Nkind (Arg) = N_Attribute_Reference then
470 -- Case of list of arguments
472 elsif Nkind (Arg) = N_Aggregate then
473 if Expressions (Arg) = No_List then
474 Operand_Var := Empty;
476 Operand_Var := First (Expressions (Arg));
479 -- Otherwise must be default (no operands) case
482 Operand_Var := Empty;
484 end Setup_Asm_IO_Args;
486 -----------------------
487 -- Setup_Asm_Outputs --
488 -----------------------
490 procedure Setup_Asm_Outputs (N : Node_Id) is
491 Call : constant Node_Id := Expression (Expression (N));
495 (Next_Actual (First_Actual (Call)),
496 Current_Output_Operand);
497 end Setup_Asm_Outputs;