]>
Commit | Line | Data |
---|---|---|
70482933 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- E X P _ C O D E -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
1d005acc | 9 | -- Copyright (C) 1996-2019, Free Software Foundation, Inc. -- |
70482933 RK |
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- -- | |
b5c84c3c | 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
70482933 RK |
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 -- | |
b5c84c3c RD |
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. -- | |
70482933 RK |
20 | -- -- |
21 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
71ff80dc | 22 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
70482933 RK |
23 | -- -- |
24 | ------------------------------------------------------------------------------ | |
25 | ||
26 | with Atree; use Atree; | |
27 | with Einfo; use Einfo; | |
28 | with Errout; use Errout; | |
70482933 RK |
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; | |
a4100e55 | 35 | with Sem_Aux; use Sem_Aux; |
70482933 RK |
36 | with Sem_Eval; use Sem_Eval; |
37 | with Sem_Util; use Sem_Util; | |
e0ae4e94 | 38 | with Sem_Warn; use Sem_Warn; |
70482933 RK |
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; | |
e0ae4e94 RD |
127 | elsif Error_Posted (Operand_Var) then |
128 | return Error; | |
70482933 RK |
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) | |
0ab80019 AC |
170 | or else (Ada_Version = Ada_83 |
171 | and then Nkind (Temp) = N_String_Literal) | |
70482933 RK |
172 | then |
173 | return Get_String_Node (Temp); | |
174 | ||
175 | else | |
fbf5a39b | 176 | Flag_Non_Static_Expr ("asm template argument is not static!", Temp); |
70482933 RK |
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 | ||
16e764a7 | 190 | Clobber_Ptr : Pos; |
70482933 RK |
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 | |
dae4faf2 | 222 | Add_Char_To_Name_Buffer (C); |
70482933 RK |
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; | |
70482933 RK |
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)))); | |
70482933 RK |
243 | begin |
244 | if not Is_OK_Static_Expression (Clob) then | |
fbf5a39b | 245 | Flag_Non_Static_Expr ("asm clobber argument is not static!", Clob); |
70482933 | 246 | Clobber_Node := Empty; |
70482933 RK |
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 | ||
e0ae4e94 RD |
263 | ---------------------- |
264 | -- Check_IO_Operand -- | |
265 | ---------------------- | |
266 | ||
70482933 RK |
267 | procedure Check_IO_Operand (N : Node_Id) is |
268 | Err : Node_Id := N; | |
269 | ||
270 | begin | |
e0ae4e94 | 271 | -- The only identifier allowed is No_xxput_Operands. Since we |
70482933 RK |
272 | -- know the type is right, it is sufficient to see if the |
273 | -- referenced entity is in a runtime routine. | |
274 | ||
bcea76b6 | 275 | if Is_Entity_Name (N) |
8ab31c0c | 276 | and then Is_Predefined_Unit (Get_Source_Unit (Entity (N))) |
70482933 RK |
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); | |
70482933 RK |
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 | |
e0ae4e94 RD |
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. | |
70482933 RK |
370 | |
371 | Set_Analyzed (N); | |
e0ae4e94 | 372 | Check_Code_Statement (N); |
70482933 RK |
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; | |
70482933 RK |
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))))); | |
70482933 RK |
402 | begin |
403 | if not Is_OK_Static_Expression (Vol) then | |
fbf5a39b | 404 | Flag_Non_Static_Expr ("asm volatile argument is not static!", Vol); |
70482933 | 405 | return False; |
70482933 RK |
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); | |
70482933 RK |
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)); | |
70482933 RK |
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)); | |
70482933 RK |
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; |