1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- E X P _ C O D E -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1996-2003 Free Software Foundation, Inc. -- 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 2, 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 COPYING. If not, write -- 19-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- 20-- MA 02111-1307, USA. -- 21-- -- 22-- GNAT was originally developed by the GNAT team at New York University. -- 23-- Extensive contributions were provided by Ada Core Technologies Inc. -- 24-- -- 25------------------------------------------------------------------------------ 26 27with Atree; use Atree; 28with Einfo; use Einfo; 29with Errout; use Errout; 30with Fname; use Fname; 31with Lib; use Lib; 32with Namet; use Namet; 33with Nlists; use Nlists; 34with Nmake; use Nmake; 35with Opt; use Opt; 36with Rtsfind; use Rtsfind; 37with Sem_Eval; use Sem_Eval; 38with Sem_Util; use Sem_Util; 39with Sinfo; use Sinfo; 40with Stringt; use Stringt; 41with Tbuild; use Tbuild; 42 43package 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 else 128 return Next (First (Expressions (Operand_Var))); 129 end if; 130 end Asm_Operand; 131 132 --------------------------- 133 -- Asm_Output_Constraint -- 134 --------------------------- 135 136 -- Note: error checking on Asm_Output attribute done in Sem_Attr 137 138 function Asm_Output_Constraint return Node_Id is 139 begin 140 return Asm_Constraint (Current_Output_Operand); 141 end Asm_Output_Constraint; 142 143 ------------------------- 144 -- Asm_Output_Variable -- 145 ------------------------- 146 147 -- Note: error checking on Asm_Output attribute done in Sem_Attr 148 149 function Asm_Output_Variable return Node_Id is 150 begin 151 return Asm_Operand (Current_Output_Operand); 152 end Asm_Output_Variable; 153 154 ------------------ 155 -- Asm_Template -- 156 ------------------ 157 158 function Asm_Template (N : Node_Id) return Node_Id is 159 Call : constant Node_Id := Expression (Expression (N)); 160 Temp : constant Node_Id := First_Actual (Call); 161 162 begin 163 -- Require static expression for template. We also allow a string 164 -- literal (this is useful for Ada 83 mode where string expressions 165 -- are never static). 166 167 if Is_OK_Static_Expression (Temp) 168 or else (Ada_83 and then Nkind (Temp) = N_String_Literal) 169 then 170 return Get_String_Node (Temp); 171 172 else 173 Flag_Non_Static_Expr ("asm template argument is not static!", Temp); 174 return Empty; 175 end if; 176 end Asm_Template; 177 178 ---------------------- 179 -- Clobber_Get_Next -- 180 ---------------------- 181 182 Clobber_Node : Node_Id; 183 -- String literal node for clobber string. Initialized by Clobber_Setup, 184 -- and not modified by Clobber_Get_Next. Empty if clobber string was in 185 -- error (resulting in no clobber arguments being returned). 186 187 Clobber_Ptr : Nat; 188 -- Pointer to current character of string. Initialized to 1 by the call 189 -- to Clobber_Setup, and then updated by Clobber_Get_Next. 190 191 function Clobber_Get_Next return Address is 192 Str : constant String_Id := Strval (Clobber_Node); 193 Len : constant Nat := String_Length (Str); 194 C : Character; 195 196 begin 197 if No (Clobber_Node) then 198 return Null_Address; 199 end if; 200 201 -- Skip spaces and commas before next register name 202 203 loop 204 -- Return null string if no more names 205 206 if Clobber_Ptr > Len then 207 return Null_Address; 208 end if; 209 210 C := Get_Character (Get_String_Char (Str, Clobber_Ptr)); 211 exit when C /= ',' and then C /= ' '; 212 Clobber_Ptr := Clobber_Ptr + 1; 213 end loop; 214 215 -- Acquire next register name 216 217 Name_Len := 0; 218 loop 219 Name_Len := Name_Len + 1; 220 Name_Buffer (Name_Len) := C; 221 Clobber_Ptr := Clobber_Ptr + 1; 222 exit when Clobber_Ptr > Len; 223 C := Get_Character (Get_String_Char (Str, Clobber_Ptr)); 224 exit when C = ',' or else C = ' '; 225 end loop; 226 227 Name_Buffer (Name_Len + 1) := ASCII.NUL; 228 return Name_Buffer'Address; 229 230 end Clobber_Get_Next; 231 232 ------------------- 233 -- Clobber_Setup -- 234 ------------------- 235 236 procedure Clobber_Setup (N : Node_Id) is 237 Call : constant Node_Id := Expression (Expression (N)); 238 Clob : constant Node_Id := Next_Actual ( 239 Next_Actual ( 240 Next_Actual ( 241 First_Actual (Call)))); 242 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 248 else 249 Clobber_Node := Get_String_Node (Clob); 250 Clobber_Ptr := 1; 251 end if; 252 end Clobber_Setup; 253 254 --------------------- 255 -- Expand_Asm_Call -- 256 --------------------- 257 258 procedure Expand_Asm_Call (N : Node_Id) is 259 Loc : constant Source_Ptr := Sloc (N); 260 261 procedure Check_IO_Operand (N : Node_Id); 262 -- Check for incorrect input or output operand 263 264 procedure Check_IO_Operand (N : Node_Id) is 265 Err : Node_Id := N; 266 267 begin 268 -- The only identifier allows is No_xxput_Operands. Since we 269 -- know the type is right, it is sufficient to see if the 270 -- referenced entity is in a runtime routine. 271 272 if Is_Entity_Name (N) 273 and then 274 Is_Predefined_File_Name (Unit_File_Name 275 (Get_Source_Unit (Entity (N)))) 276 then 277 return; 278 279 -- An attribute reference is fine, again the analysis reasonably 280 -- guarantees that the attribute must be subtype'Asm_??put. 281 282 elsif Nkind (N) = N_Attribute_Reference then 283 return; 284 285 -- The only other allowed form is an array aggregate in which 286 -- all the entries are positional and are attribute references. 287 288 elsif Nkind (N) = N_Aggregate then 289 if Present (Component_Associations (N)) then 290 Err := First (Component_Associations (N)); 291 292 elsif Present (Expressions (N)) then 293 Err := First (Expressions (N)); 294 while Present (Err) loop 295 exit when Nkind (Err) /= N_Attribute_Reference; 296 Next (Err); 297 end loop; 298 299 if No (Err) then 300 return; 301 end if; 302 end if; 303 end if; 304 305 -- If we fall through, Err is pointing to the bad node 306 307 Error_Msg_N ("Asm operand has wrong form", Err); 308 end Check_IO_Operand; 309 310 -- Start of processing for Expand_Asm_Call 311 312 begin 313 -- Check that the input and output operands have the right 314 -- form, as required by the documentation of the Asm feature: 315 316 -- OUTPUT_OPERAND_LIST ::= 317 -- No_Output_Operands 318 -- | OUTPUT_OPERAND_ATTRIBUTE 319 -- | (OUTPUT_OPERAND_ATTRIBUTE @{,OUTPUT_OPERAND_ATTRIBUTE@}) 320 321 -- OUTPUT_OPERAND_ATTRIBUTE ::= 322 -- SUBTYPE_MARK'Asm_Output (static_string_EXPRESSION, NAME) 323 324 -- INPUT_OPERAND_LIST ::= 325 -- No_Input_Operands 326 -- | INPUT_OPERAND_ATTRIBUTE 327 -- | (INPUT_OPERAND_ATTRIBUTE @{,INPUT_OPERAND_ATTRIBUTE@}) 328 329 -- INPUT_OPERAND_ATTRIBUTE ::= 330 -- SUBTYPE_MARK'Asm_Input (static_string_EXPRESSION, EXPRESSION) 331 332 declare 333 Arg_Output : constant Node_Id := Next_Actual (First_Actual (N)); 334 Arg_Input : constant Node_Id := Next_Actual (Arg_Output); 335 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. 367 368 Set_Analyzed (N); 369 end if; 370 end Expand_Asm_Call; 371 372 --------------------- 373 -- Get_String_Node -- 374 --------------------- 375 376 function Get_String_Node (S : Node_Id) return Node_Id is 377 begin 378 if Nkind (S) = N_String_Literal then 379 return S; 380 381 else 382 pragma Assert (Ekind (Entity (S)) = E_Constant); 383 return Get_String_Node (Constant_Value (Entity (S))); 384 end if; 385 end Get_String_Node; 386 387 --------------------- 388 -- Is_Asm_Volatile -- 389 --------------------- 390 391 function Is_Asm_Volatile (N : Node_Id) return Boolean is 392 Call : constant Node_Id := Expression (Expression (N)); 393 Vol : constant Node_Id := 394 Next_Actual ( 395 Next_Actual ( 396 Next_Actual ( 397 Next_Actual ( 398 First_Actual (Call))))); 399 400 begin 401 if not Is_OK_Static_Expression (Vol) then 402 Flag_Non_Static_Expr ("asm volatile argument is not static!", Vol); 403 return False; 404 405 else 406 return Is_True (Expr_Value (Vol)); 407 end if; 408 end Is_Asm_Volatile; 409 410 -------------------- 411 -- Next_Asm_Input -- 412 -------------------- 413 414 procedure Next_Asm_Input is 415 begin 416 Next_Asm_Operand (Current_Input_Operand); 417 end Next_Asm_Input; 418 419 ---------------------- 420 -- Next_Asm_Operand -- 421 ---------------------- 422 423 procedure Next_Asm_Operand (Operand_Var : in out Node_Id) is 424 begin 425 pragma Assert (Present (Operand_Var)); 426 427 if Nkind (Parent (Operand_Var)) = N_Aggregate then 428 Operand_Var := Next (Operand_Var); 429 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 451 begin 452 Setup_Asm_IO_Args 453 (Next_Actual (Next_Actual (First_Actual (Call))), 454 Current_Input_Operand); 455 end Setup_Asm_Inputs; 456 457 ----------------------- 458 -- Setup_Asm_IO_Args -- 459 ----------------------- 460 461 procedure Setup_Asm_IO_Args (Arg : Node_Id; Operand_Var : out Node_Id) is 462 begin 463 -- Case of single argument 464 465 if Nkind (Arg) = N_Attribute_Reference then 466 Operand_Var := Arg; 467 468 -- Case of list of arguments 469 470 elsif Nkind (Arg) = N_Aggregate then 471 if Expressions (Arg) = No_List then 472 Operand_Var := Empty; 473 else 474 Operand_Var := First (Expressions (Arg)); 475 end if; 476 477 -- Otherwise must be default (no operands) case 478 479 else 480 Operand_Var := Empty; 481 end if; 482 end Setup_Asm_IO_Args; 483 484 ----------------------- 485 -- Setup_Asm_Outputs -- 486 ----------------------- 487 488 procedure Setup_Asm_Outputs (N : Node_Id) is 489 Call : constant Node_Id := Expression (Expression (N)); 490 491 begin 492 Setup_Asm_IO_Args 493 (Next_Actual (First_Actual (Call)), 494 Current_Output_Operand); 495 end Setup_Asm_Outputs; 496 497end Exp_Code; 498