|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- E X P _ C O D E --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
145
|
9 -- Copyright (C) 1996-2019, Free Software Foundation, Inc. --
|
|
111
|
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 -- GNAT was originally developed by the GNAT team at New York University. --
|
|
|
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
|
23 -- --
|
|
|
24 ------------------------------------------------------------------------------
|
|
|
25
|
|
|
26 with Atree; use Atree;
|
|
|
27 with Einfo; use Einfo;
|
|
|
28 with Errout; use Errout;
|
|
|
29 with Lib; use Lib;
|
|
|
30 with Namet; use Namet;
|
|
|
31 with Nlists; use Nlists;
|
|
|
32 with Nmake; use Nmake;
|
|
|
33 with Opt; use Opt;
|
|
|
34 with Rtsfind; use Rtsfind;
|
|
|
35 with Sem_Aux; use Sem_Aux;
|
|
|
36 with Sem_Eval; use Sem_Eval;
|
|
|
37 with Sem_Util; use Sem_Util;
|
|
|
38 with Sem_Warn; use Sem_Warn;
|
|
|
39 with Sinfo; use Sinfo;
|
|
|
40 with Stringt; use Stringt;
|
|
|
41 with Tbuild; use Tbuild;
|
|
|
42
|
|
|
43 package body Exp_Code is
|
|
|
44
|
|
|
45 -----------------------
|
|
|
46 -- Local_Subprograms --
|
|
|
47 -----------------------
|
|
|
48
|
|
|
49 function Asm_Constraint (Operand_Var : Node_Id) return Node_Id;
|
|
|
50 -- Common processing for Asm_Input_Constraint and Asm_Output_Constraint.
|
|
|
51 -- Obtains the constraint argument from the global operand variable
|
|
|
52 -- Operand_Var, which must be non-Empty.
|
|
|
53
|
|
|
54 function Asm_Operand (Operand_Var : Node_Id) return Node_Id;
|
|
|
55 -- Common processing for Asm_Input_Value and Asm_Output_Variable. Obtains
|
|
|
56 -- the value/variable argument from Operand_Var, the global operand
|
|
|
57 -- variable. Returns Empty if no operand available.
|
|
|
58
|
|
|
59 function Get_String_Node (S : Node_Id) return Node_Id;
|
|
|
60 -- Given S, a static expression node of type String, returns the
|
|
|
61 -- string literal node. This is needed to deal with the use of constants
|
|
|
62 -- for these expressions, which is perfectly permissible.
|
|
|
63
|
|
|
64 procedure Next_Asm_Operand (Operand_Var : in out Node_Id);
|
|
|
65 -- Common processing for Next_Asm_Input and Next_Asm_Output, updates
|
|
|
66 -- the value of the global operand variable Operand_Var appropriately.
|
|
|
67
|
|
|
68 procedure Setup_Asm_IO_Args (Arg : Node_Id; Operand_Var : out Node_Id);
|
|
|
69 -- Common processing for Setup_Asm_Inputs and Setup_Asm_Outputs. Arg
|
|
|
70 -- is the actual parameter from the call, and Operand_Var is the global
|
|
|
71 -- operand variable to be initialized to the first operand.
|
|
|
72
|
|
|
73 ----------------------
|
|
|
74 -- Global Variables --
|
|
|
75 ----------------------
|
|
|
76
|
|
|
77 Current_Input_Operand : Node_Id := Empty;
|
|
|
78 -- Points to current Asm_Input_Operand attribute reference. Initialized
|
|
|
79 -- by Setup_Asm_Inputs, updated by Next_Asm_Input, and referenced by
|
|
|
80 -- Asm_Input_Constraint and Asm_Input_Value.
|
|
|
81
|
|
|
82 Current_Output_Operand : Node_Id := Empty;
|
|
|
83 -- Points to current Asm_Output_Operand attribute reference. Initialized
|
|
|
84 -- by Setup_Asm_Outputs, updated by Next_Asm_Output, and referenced by
|
|
|
85 -- Asm_Output_Constraint and Asm_Output_Variable.
|
|
|
86
|
|
|
87 --------------------
|
|
|
88 -- Asm_Constraint --
|
|
|
89 --------------------
|
|
|
90
|
|
|
91 function Asm_Constraint (Operand_Var : Node_Id) return Node_Id is
|
|
|
92 begin
|
|
|
93 pragma Assert (Present (Operand_Var));
|
|
|
94 return Get_String_Node (First (Expressions (Operand_Var)));
|
|
|
95 end Asm_Constraint;
|
|
|
96
|
|
|
97 --------------------------
|
|
|
98 -- Asm_Input_Constraint --
|
|
|
99 --------------------------
|
|
|
100
|
|
|
101 -- Note: error checking on Asm_Input attribute done in Sem_Attr
|
|
|
102
|
|
|
103 function Asm_Input_Constraint return Node_Id is
|
|
|
104 begin
|
|
|
105 return Get_String_Node (Asm_Constraint (Current_Input_Operand));
|
|
|
106 end Asm_Input_Constraint;
|
|
|
107
|
|
|
108 ---------------------
|
|
|
109 -- Asm_Input_Value --
|
|
|
110 ---------------------
|
|
|
111
|
|
|
112 -- Note: error checking on Asm_Input attribute done in Sem_Attr
|
|
|
113
|
|
|
114 function Asm_Input_Value return Node_Id is
|
|
|
115 begin
|
|
|
116 return Asm_Operand (Current_Input_Operand);
|
|
|
117 end Asm_Input_Value;
|
|
|
118
|
|
|
119 -----------------
|
|
|
120 -- Asm_Operand --
|
|
|
121 -----------------
|
|
|
122
|
|
|
123 function Asm_Operand (Operand_Var : Node_Id) return Node_Id is
|
|
|
124 begin
|
|
|
125 if No (Operand_Var) then
|
|
|
126 return Empty;
|
|
|
127 elsif Error_Posted (Operand_Var) then
|
|
|
128 return Error;
|
|
|
129 else
|
|
|
130 return Next (First (Expressions (Operand_Var)));
|
|
|
131 end if;
|
|
|
132 end Asm_Operand;
|
|
|
133
|
|
|
134 ---------------------------
|
|
|
135 -- Asm_Output_Constraint --
|
|
|
136 ---------------------------
|
|
|
137
|
|
|
138 -- Note: error checking on Asm_Output attribute done in Sem_Attr
|
|
|
139
|
|
|
140 function Asm_Output_Constraint return Node_Id is
|
|
|
141 begin
|
|
|
142 return Asm_Constraint (Current_Output_Operand);
|
|
|
143 end Asm_Output_Constraint;
|
|
|
144
|
|
|
145 -------------------------
|
|
|
146 -- Asm_Output_Variable --
|
|
|
147 -------------------------
|
|
|
148
|
|
|
149 -- Note: error checking on Asm_Output attribute done in Sem_Attr
|
|
|
150
|
|
|
151 function Asm_Output_Variable return Node_Id is
|
|
|
152 begin
|
|
|
153 return Asm_Operand (Current_Output_Operand);
|
|
|
154 end Asm_Output_Variable;
|
|
|
155
|
|
|
156 ------------------
|
|
|
157 -- Asm_Template --
|
|
|
158 ------------------
|
|
|
159
|
|
|
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);
|
|
|
163
|
|
|
164 begin
|
|
|
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).
|
|
|
168
|
|
|
169 if Is_OK_Static_Expression (Temp)
|
|
|
170 or else (Ada_Version = Ada_83
|
|
|
171 and then Nkind (Temp) = N_String_Literal)
|
|
|
172 then
|
|
|
173 return Get_String_Node (Temp);
|
|
|
174
|
|
|
175 else
|
|
|
176 Flag_Non_Static_Expr ("asm template argument is not static!", Temp);
|
|
|
177 return Empty;
|
|
|
178 end if;
|
|
|
179 end Asm_Template;
|
|
|
180
|
|
|
181 ----------------------
|
|
|
182 -- Clobber_Get_Next --
|
|
|
183 ----------------------
|
|
|
184
|
|
|
185 Clobber_Node : Node_Id;
|
|
|
186 -- String literal node for clobber string. Initialized by Clobber_Setup,
|
|
|
187 -- and not modified by Clobber_Get_Next. Empty if clobber string was in
|
|
|
188 -- error (resulting in no clobber arguments being returned).
|
|
|
189
|
|
|
190 Clobber_Ptr : Pos;
|
|
|
191 -- Pointer to current character of string. Initialized to 1 by the call
|
|
|
192 -- to Clobber_Setup, and then updated by Clobber_Get_Next.
|
|
|
193
|
|
|
194 function Clobber_Get_Next return Address is
|
|
|
195 Str : constant String_Id := Strval (Clobber_Node);
|
|
|
196 Len : constant Nat := String_Length (Str);
|
|
|
197 C : Character;
|
|
|
198
|
|
|
199 begin
|
|
|
200 if No (Clobber_Node) then
|
|
|
201 return Null_Address;
|
|
|
202 end if;
|
|
|
203
|
|
|
204 -- Skip spaces and commas before next register name
|
|
|
205
|
|
|
206 loop
|
|
|
207 -- Return null string if no more names
|
|
|
208
|
|
|
209 if Clobber_Ptr > Len then
|
|
|
210 return Null_Address;
|
|
|
211 end if;
|
|
|
212
|
|
|
213 C := Get_Character (Get_String_Char (Str, Clobber_Ptr));
|
|
|
214 exit when C /= ',' and then C /= ' ';
|
|
|
215 Clobber_Ptr := Clobber_Ptr + 1;
|
|
|
216 end loop;
|
|
|
217
|
|
|
218 -- Acquire next register name
|
|
|
219
|
|
|
220 Name_Len := 0;
|
|
|
221 loop
|
|
|
222 Add_Char_To_Name_Buffer (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 = ' ';
|
|
|
227 end loop;
|
|
|
228
|
|
|
229 Name_Buffer (Name_Len + 1) := ASCII.NUL;
|
|
|
230 return Name_Buffer'Address;
|
|
|
231 end Clobber_Get_Next;
|
|
|
232
|
|
|
233 -------------------
|
|
|
234 -- Clobber_Setup --
|
|
|
235 -------------------
|
|
|
236
|
|
|
237 procedure Clobber_Setup (N : Node_Id) is
|
|
|
238 Call : constant Node_Id := Expression (Expression (N));
|
|
|
239 Clob : constant Node_Id := Next_Actual (
|
|
|
240 Next_Actual (
|
|
|
241 Next_Actual (
|
|
|
242 First_Actual (Call))));
|
|
|
243 begin
|
|
|
244 if not Is_OK_Static_Expression (Clob) then
|
|
|
245 Flag_Non_Static_Expr ("asm clobber argument is not static!", Clob);
|
|
|
246 Clobber_Node := Empty;
|
|
|
247 else
|
|
|
248 Clobber_Node := Get_String_Node (Clob);
|
|
|
249 Clobber_Ptr := 1;
|
|
|
250 end if;
|
|
|
251 end Clobber_Setup;
|
|
|
252
|
|
|
253 ---------------------
|
|
|
254 -- Expand_Asm_Call --
|
|
|
255 ---------------------
|
|
|
256
|
|
|
257 procedure Expand_Asm_Call (N : Node_Id) is
|
|
|
258 Loc : constant Source_Ptr := Sloc (N);
|
|
|
259
|
|
|
260 procedure Check_IO_Operand (N : Node_Id);
|
|
|
261 -- Check for incorrect input or output operand
|
|
|
262
|
|
|
263 ----------------------
|
|
|
264 -- Check_IO_Operand --
|
|
|
265 ----------------------
|
|
|
266
|
|
|
267 procedure Check_IO_Operand (N : Node_Id) is
|
|
|
268 Err : Node_Id := N;
|
|
|
269
|
|
|
270 begin
|
|
|
271 -- The only identifier allowed is No_xxput_Operands. Since we
|
|
|
272 -- know the type is right, it is sufficient to see if the
|
|
|
273 -- referenced entity is in a runtime routine.
|
|
|
274
|
|
|
275 if Is_Entity_Name (N)
|
|
|
276 and then Is_Predefined_Unit (Get_Source_Unit (Entity (N)))
|
|
|
277 then
|
|
|
278 return;
|
|
|
279
|
|
|
280 -- An attribute reference is fine, again the analysis reasonably
|
|
|
281 -- guarantees that the attribute must be subtype'Asm_??put.
|
|
|
282
|
|
|
283 elsif Nkind (N) = N_Attribute_Reference then
|
|
|
284 return;
|
|
|
285
|
|
|
286 -- The only other allowed form is an array aggregate in which
|
|
|
287 -- all the entries are positional and are attribute references.
|
|
|
288
|
|
|
289 elsif Nkind (N) = N_Aggregate then
|
|
|
290 if Present (Component_Associations (N)) then
|
|
|
291 Err := First (Component_Associations (N));
|
|
|
292
|
|
|
293 elsif Present (Expressions (N)) then
|
|
|
294 Err := First (Expressions (N));
|
|
|
295 while Present (Err) loop
|
|
|
296 exit when Nkind (Err) /= N_Attribute_Reference;
|
|
|
297 Next (Err);
|
|
|
298 end loop;
|
|
|
299
|
|
|
300 if No (Err) then
|
|
|
301 return;
|
|
|
302 end if;
|
|
|
303 end if;
|
|
|
304 end if;
|
|
|
305
|
|
|
306 -- If we fall through, Err is pointing to the bad node
|
|
|
307
|
|
|
308 Error_Msg_N ("Asm operand has wrong form", Err);
|
|
|
309 end Check_IO_Operand;
|
|
|
310
|
|
|
311 -- Start of processing for Expand_Asm_Call
|
|
|
312
|
|
|
313 begin
|
|
|
314 -- Check that the input and output operands have the right
|
|
|
315 -- form, as required by the documentation of the Asm feature:
|
|
|
316
|
|
|
317 -- OUTPUT_OPERAND_LIST ::=
|
|
|
318 -- No_Output_Operands
|
|
|
319 -- | OUTPUT_OPERAND_ATTRIBUTE
|
|
|
320 -- | (OUTPUT_OPERAND_ATTRIBUTE @{,OUTPUT_OPERAND_ATTRIBUTE@})
|
|
|
321
|
|
|
322 -- OUTPUT_OPERAND_ATTRIBUTE ::=
|
|
|
323 -- SUBTYPE_MARK'Asm_Output (static_string_EXPRESSION, NAME)
|
|
|
324
|
|
|
325 -- INPUT_OPERAND_LIST ::=
|
|
|
326 -- No_Input_Operands
|
|
|
327 -- | INPUT_OPERAND_ATTRIBUTE
|
|
|
328 -- | (INPUT_OPERAND_ATTRIBUTE @{,INPUT_OPERAND_ATTRIBUTE@})
|
|
|
329
|
|
|
330 -- INPUT_OPERAND_ATTRIBUTE ::=
|
|
|
331 -- SUBTYPE_MARK'Asm_Input (static_string_EXPRESSION, EXPRESSION)
|
|
|
332
|
|
|
333 declare
|
|
|
334 Arg_Output : constant Node_Id := Next_Actual (First_Actual (N));
|
|
|
335 Arg_Input : constant Node_Id := Next_Actual (Arg_Output);
|
|
|
336 begin
|
|
|
337 Check_IO_Operand (Arg_Output);
|
|
|
338 Check_IO_Operand (Arg_Input);
|
|
|
339 end;
|
|
|
340
|
|
|
341 -- If we have the function call case, we are inside a code statement,
|
|
|
342 -- and the tree is already in the necessary form for gigi.
|
|
|
343
|
|
|
344 if Nkind (N) = N_Function_Call then
|
|
|
345 null;
|
|
|
346
|
|
|
347 -- For the procedure case, we convert the call into a code statement
|
|
|
348
|
|
|
349 else
|
|
|
350 pragma Assert (Nkind (N) = N_Procedure_Call_Statement);
|
|
|
351
|
|
|
352 -- Note: strictly we should change the procedure call to a function
|
|
|
353 -- call in the qualified expression, but since we are not going to
|
|
|
354 -- reanalyze (see below), and the interface subprograms in this
|
|
|
355 -- package don't care, we can leave it as a procedure call.
|
|
|
356
|
|
|
357 Rewrite (N,
|
|
|
358 Make_Code_Statement (Loc,
|
|
|
359 Expression =>
|
|
|
360 Make_Qualified_Expression (Loc,
|
|
|
361 Subtype_Mark => New_Occurrence_Of (RTE (RE_Asm_Insn), Loc),
|
|
|
362 Expression => Relocate_Node (N))));
|
|
|
363
|
|
|
364 -- There is no need to reanalyze this node, it is completely analyzed
|
|
|
365 -- already, at least sufficiently for the purposes of the abstract
|
|
|
366 -- procedural interface defined in this package. Furthermore if we
|
|
|
367 -- let it go through the normal analysis, that would include some
|
|
|
368 -- inappropriate checks that apply only to explicit code statements
|
|
|
369 -- in the source, and not to calls to intrinsics.
|
|
|
370
|
|
|
371 Set_Analyzed (N);
|
|
|
372 Check_Code_Statement (N);
|
|
|
373 end if;
|
|
|
374 end Expand_Asm_Call;
|
|
|
375
|
|
|
376 ---------------------
|
|
|
377 -- Get_String_Node --
|
|
|
378 ---------------------
|
|
|
379
|
|
|
380 function Get_String_Node (S : Node_Id) return Node_Id is
|
|
|
381 begin
|
|
|
382 if Nkind (S) = N_String_Literal then
|
|
|
383 return S;
|
|
|
384 else
|
|
|
385 pragma Assert (Ekind (Entity (S)) = E_Constant);
|
|
|
386 return Get_String_Node (Constant_Value (Entity (S)));
|
|
|
387 end if;
|
|
|
388 end Get_String_Node;
|
|
|
389
|
|
|
390 ---------------------
|
|
|
391 -- Is_Asm_Volatile --
|
|
|
392 ---------------------
|
|
|
393
|
|
|
394 function Is_Asm_Volatile (N : Node_Id) return Boolean is
|
|
|
395 Call : constant Node_Id := Expression (Expression (N));
|
|
|
396 Vol : constant Node_Id :=
|
|
|
397 Next_Actual (
|
|
|
398 Next_Actual (
|
|
|
399 Next_Actual (
|
|
|
400 Next_Actual (
|
|
|
401 First_Actual (Call)))));
|
|
|
402 begin
|
|
|
403 if not Is_OK_Static_Expression (Vol) then
|
|
|
404 Flag_Non_Static_Expr ("asm volatile argument is not static!", Vol);
|
|
|
405 return False;
|
|
|
406 else
|
|
|
407 return Is_True (Expr_Value (Vol));
|
|
|
408 end if;
|
|
|
409 end Is_Asm_Volatile;
|
|
|
410
|
|
|
411 --------------------
|
|
|
412 -- Next_Asm_Input --
|
|
|
413 --------------------
|
|
|
414
|
|
|
415 procedure Next_Asm_Input is
|
|
|
416 begin
|
|
|
417 Next_Asm_Operand (Current_Input_Operand);
|
|
|
418 end Next_Asm_Input;
|
|
|
419
|
|
|
420 ----------------------
|
|
|
421 -- Next_Asm_Operand --
|
|
|
422 ----------------------
|
|
|
423
|
|
|
424 procedure Next_Asm_Operand (Operand_Var : in out Node_Id) is
|
|
|
425 begin
|
|
|
426 pragma Assert (Present (Operand_Var));
|
|
|
427
|
|
|
428 if Nkind (Parent (Operand_Var)) = N_Aggregate then
|
|
|
429 Operand_Var := Next (Operand_Var);
|
|
|
430 else
|
|
|
431 Operand_Var := Empty;
|
|
|
432 end if;
|
|
|
433 end Next_Asm_Operand;
|
|
|
434
|
|
|
435 ---------------------
|
|
|
436 -- Next_Asm_Output --
|
|
|
437 ---------------------
|
|
|
438
|
|
|
439 procedure Next_Asm_Output is
|
|
|
440 begin
|
|
|
441 Next_Asm_Operand (Current_Output_Operand);
|
|
|
442 end Next_Asm_Output;
|
|
|
443
|
|
|
444 ----------------------
|
|
|
445 -- Setup_Asm_Inputs --
|
|
|
446 ----------------------
|
|
|
447
|
|
|
448 procedure Setup_Asm_Inputs (N : Node_Id) is
|
|
|
449 Call : constant Node_Id := Expression (Expression (N));
|
|
|
450 begin
|
|
|
451 Setup_Asm_IO_Args
|
|
|
452 (Next_Actual (Next_Actual (First_Actual (Call))),
|
|
|
453 Current_Input_Operand);
|
|
|
454 end Setup_Asm_Inputs;
|
|
|
455
|
|
|
456 -----------------------
|
|
|
457 -- Setup_Asm_IO_Args --
|
|
|
458 -----------------------
|
|
|
459
|
|
|
460 procedure Setup_Asm_IO_Args (Arg : Node_Id; Operand_Var : out Node_Id) is
|
|
|
461 begin
|
|
|
462 -- Case of single argument
|
|
|
463
|
|
|
464 if Nkind (Arg) = N_Attribute_Reference then
|
|
|
465 Operand_Var := Arg;
|
|
|
466
|
|
|
467 -- Case of list of arguments
|
|
|
468
|
|
|
469 elsif Nkind (Arg) = N_Aggregate then
|
|
|
470 if Expressions (Arg) = No_List then
|
|
|
471 Operand_Var := Empty;
|
|
|
472 else
|
|
|
473 Operand_Var := First (Expressions (Arg));
|
|
|
474 end if;
|
|
|
475
|
|
|
476 -- Otherwise must be default (no operands) case
|
|
|
477
|
|
|
478 else
|
|
|
479 Operand_Var := Empty;
|
|
|
480 end if;
|
|
|
481 end Setup_Asm_IO_Args;
|
|
|
482
|
|
|
483 -----------------------
|
|
|
484 -- Setup_Asm_Outputs --
|
|
|
485 -----------------------
|
|
|
486
|
|
|
487 procedure Setup_Asm_Outputs (N : Node_Id) is
|
|
|
488 Call : constant Node_Id := Expression (Expression (N));
|
|
|
489 begin
|
|
|
490 Setup_Asm_IO_Args
|
|
|
491 (Next_Actual (First_Actual (Call)),
|
|
|
492 Current_Output_Operand);
|
|
|
493 end Setup_Asm_Outputs;
|
|
|
494
|
|
|
495 end Exp_Code;
|
