1-- Mcode back-end for ortho - mcode to X86 instructions. 2-- Copyright (C) 2006 - 2015 Tristan Gingold 3-- 4-- This program is free software: you can redistribute it and/or modify 5-- it under the terms of the GNU General Public License as published by 6-- the Free Software Foundation, either version 2 of the License, or 7-- (at your option) any later version. 8-- 9-- This program is distributed in the hope that it will be useful, 10-- but WITHOUT ANY WARRANTY; without even the implied warranty of 11-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12-- GNU General Public License for more details. 13-- 14-- You should have received a copy of the GNU General Public License 15-- along with this program. If not, see <gnu.org/licenses>. 16 17-- Instruction pass for mcode x86. 18-- 19-- The purpose of this pass is the transform the AST (the input) into a list 20-- of x86 instructions and to allocate registers. 21-- 22-- The AST given in input is already linearized: ifs, loops, cases have been 23-- translated to labels and jumps. So the input is a list of statement to 24-- execute, intermixed with declaration blocks. 25-- 26-- The first purpose of this pass is to translate statements (and expressions) 27-- to x86 instructions. This isn't particularly difficult as they are already 28-- low-level statements and expression (by design of the language). The 29-- algorithm simply try to put as much as possible into an instruction (in 30-- order to use the address operand encoding of x86: base, index and scale): 31-- AST is split into small trees (sometime as small as a single node) and 32-- linearized. Each node represent a fix pattern of one or a few instructions 33-- (in some case, like a 64 bit addition, we need more than one x86 34-- instruction). 35-- The core functions of this package (Gen_Insn and Gen_Insn_Stmt) do the 36-- work: they call Gen_Insn for each operand, then append themself to the 37-- result using Link_Stmt. 38-- 39-- The second purpose of this pass is to perform register allocation. This 40-- is done in the same time. 41-- There are two sources of constraints for register allocation: 42-- - external constraint on the result: for example, the return value of 43-- a function must be in a fixed register (defined by the ABI). 44-- - instruction constraint on the result: some x86 instructions (like div) 45-- specify the result register. This constraint will be forward propagated 46-- to next instructions. 47-- - instruction constraint on the operand: most x86 instructions set the 48-- result in one of the operand register, and some instructions (like shl) 49-- have a fixed register for an operand (like the shift count). This 50-- constraint has to be backward propagated to previous instructions. 51-- Obviously constraints may be incompatible: the result of an instruction 52-- may be in a different register than the input of the next instruction. 53-- In this case, move instructions are added. 54-- It is possible (and quite easily) to run out of registers. In that case 55-- some values must be spilt (save) on the stack and will be reloaded later. 56-- Registers are allocated statement by statement. So after each statement 57-- all registers should be unused (this is a very basic register allocator). 58-- 59-- Finally, this pass also allocate stack slots for local variables, and 60-- compute the size of the frame. 61 62with Interfaces; 63with Ada.Text_IO; 64with Ortho_Code.Abi; 65with Ortho_Code.Decls; use Ortho_Code.Decls; 66with Ortho_Code.Types; use Ortho_Code.Types; 67with Ortho_Code.Debug; 68with Ortho_Code.X86.Flags; 69 70package body Ortho_Code.X86.Insns is 71 -- Add STMT to the list of instructions. 72 procedure Link_Stmt (Stmt : O_Enode) 73 is 74 use Ortho_Code.Abi; 75 begin 76 Set_Stmt_Link (Last_Link, Stmt); 77 Last_Link := Stmt; 78 if Debug.Flag_Debug_Insn then 79 Disp_Stmt (Stmt); 80 end if; 81 end Link_Stmt; 82 83 function Is_External_Object (Obj : O_Dnode) return Boolean is 84 begin 85 return Flags.M64 86 and then Get_Decl_Storage (Obj) = O_Storage_External; 87 end Is_External_Object; 88 89 -- Return the 'any register' constraint for mode MODE. 90 function Get_Reg_Any (Mode : Mode_Type) return O_Reg is 91 begin 92 case Mode is 93 when Mode_I16 .. Mode_I32 94 | Mode_U16 .. Mode_U32 95 | Mode_P32 => 96 return R_Any32; 97 when Mode_I8 98 | Mode_U8 99 | Mode_B2 => 100 return R_Any8; 101 when Mode_U64 102 | Mode_I64 103 | Mode_P64 => 104 if Flags.M64 then 105 return R_Any64; 106 else 107 return R_AnyPair; 108 end if; 109 when Mode_F32 110 | Mode_F64 => 111 if Abi.Flag_Sse2 then 112 return R_Any_Xmm; 113 else 114 return R_St0; 115 end if; 116 when Mode_X1 117 | Mode_Nil 118 | Mode_Blk => 119 raise Program_Error; 120 end case; 121 end Get_Reg_Any; 122 123 function Get_Reg_Any (Stmt : O_Enode) return O_Reg is 124 begin 125 return Get_Reg_Any (Get_Expr_Mode (Stmt)); 126 end Get_Reg_Any; 127 128 -- Stack slot management. 129 Stack_Offset : Uns32 := 0; 130 Stack_Max : Uns32 := 0; 131 132 -- Count how many bytes have been pushed on the stack, during a call. This 133 -- is used to correctly align the stack for nested calls. 134 Push_Offset : Uns32 := 0; 135 136 -- If True, allocate 8 bytes on the stack for fp-int/sse conversion. 137 Need_Fp_Conv_Slot : Boolean := False; 138 139 -- STMT is an OE_END statement. 140 -- Swap Stack_Offset with Max_Stack of STMT. 141 procedure Swap_Stack_Offset (Blk : O_Dnode) 142 is 143 Prev_Offset : Uns32; 144 begin 145 Prev_Offset := Get_Block_Max_Stack (Blk); 146 Set_Block_Max_Stack (Blk, Stack_Offset); 147 Stack_Offset := Prev_Offset; 148 end Swap_Stack_Offset; 149 150 -- Allocate a slot for each local variable. 151 procedure Expand_Decls (Block : O_Dnode) 152 is 153 pragma Assert (Get_Decl_Kind (Block) = OD_Block); 154 Last : constant O_Dnode := Get_Block_Last (Block); 155 Decl : O_Dnode; 156 Decl_Type : O_Tnode; 157 begin 158 Decl := Block + 1; 159 while Decl <= Last loop 160 case Get_Decl_Kind (Decl) is 161 when OD_Local => 162 Decl_Type := Get_Decl_Type (Decl); 163 -- Align and allocate (on the stack). 164 Stack_Offset := Do_Align (Stack_Offset, Decl_Type); 165 Stack_Offset := Stack_Offset + Get_Type_Size (Decl_Type); 166 Set_Local_Offset (Decl, -Int32 (Stack_Offset)); 167 -- If the frame gets lager, set the maximum size. 168 if Stack_Offset > Stack_Max then 169 Stack_Max := Stack_Offset; 170 end if; 171 when OD_Type 172 | OD_Const 173 | OD_Init_Val 174 | OD_Var 175 | OD_Function 176 | OD_Procedure 177 | OD_Interface 178 | OD_Body 179 | OD_Subprg_Ext => 180 null; 181 when OD_Block => 182 Decl := Get_Block_Last (Decl); 183 end case; 184 Decl := Decl + 1; 185 end loop; 186 end Expand_Decls; 187 188 -- Condition code for unsigned comparaison. 189 function Ekind_Unsigned_To_Cc (Kind : OE_Kind_Cmp) return O_Reg is 190 begin 191 case Kind is 192 when OE_Eq => 193 return R_Eq; 194 when OE_Neq => 195 return R_Ne; 196 when OE_Lt => 197 return R_Ult; 198 when OE_Le => 199 return R_Ule; 200 when OE_Gt => 201 return R_Ugt; 202 when OE_Ge => 203 return R_Uge; 204 end case; 205 end Ekind_Unsigned_To_Cc; 206 207 -- Condition code for signed comparaison. 208 function Ekind_Signed_To_Cc (Kind : OE_Kind_Cmp) return O_Reg is 209 begin 210 case Kind is 211 when OE_Eq => 212 return R_Eq; 213 when OE_Neq => 214 return R_Ne; 215 when OE_Lt => 216 return R_Slt; 217 when OE_Le => 218 return R_Sle; 219 when OE_Gt => 220 return R_Sgt; 221 when OE_Ge => 222 return R_Sge; 223 end case; 224 end Ekind_Signed_To_Cc; 225 226 function Ekind_To_Cc (Stmt : O_Enode; Mode : Mode_Type) return O_Reg 227 is 228 Kind : constant OE_Kind := Get_Expr_Kind (Stmt); 229 begin 230 case Mode is 231 when Mode_U8 .. Mode_U64 232 | Mode_F32 .. Mode_F64 233 | Mode_P32 234 | Mode_P64 235 | Mode_B2 => 236 return Ekind_Unsigned_To_Cc (Kind); 237 when Mode_I8 .. Mode_I64 => 238 return Ekind_Signed_To_Cc (Kind); 239 when others => 240 raise Program_Error; 241 end case; 242 end Ekind_To_Cc; 243 244 -- CC is the result of A CMP B. 245 -- Returns the condition for B CMP A. 246 function Reverse_Cc (Cc : O_Reg) return O_Reg 247 is 248 -- Only used when not sse. 249 pragma Assert (not Abi.Flag_Sse2); 250 begin 251 case Cc is 252 when R_Ult => 253 return R_Ugt; 254 when R_Uge => 255 return R_Ule; 256 when R_Eq => 257 return R_Eq; 258 when R_Ne => 259 return R_Ne; 260 when R_Ule => 261 return R_Uge; 262 when R_Ugt => 263 return R_Ult; 264 when R_Slt => 265 return R_Sgt; 266 when R_Sge => 267 return R_Sle; 268 when R_Sle => 269 return R_Sge; 270 when R_Sgt => 271 return R_Slt; 272 when others => 273 raise Program_Error; 274 end case; 275 end Reverse_Cc; 276 277 -- Get the register in which a function result for MODE is returned. 278 function Get_Return_Register (Mode : Mode_Type) return O_Reg is 279 begin 280 case Mode is 281 when Mode_U8 .. Mode_U32 282 | Mode_I8 .. Mode_I32 283 | Mode_P32 284 | Mode_B2 => 285 return R_Ax; 286 when Mode_U64 287 | Mode_I64 288 | Mode_P64 => 289 if Flags.M64 then 290 return R_Ax; 291 else 292 return R_Edx_Eax; 293 end if; 294 when Mode_F32 295 | Mode_F64 => 296 if Abi.Flag_Sse2 then 297 -- Strictly speaking, this is not true as ST0 is used on x86. 298 -- The conversion is done by emits (this requires a stack 299 -- slot). 300 if not Flags.M64 then 301 Need_Fp_Conv_Slot := True; 302 end if; 303 return R_Xmm0; 304 else 305 return R_St0; 306 end if; 307 when Mode_Nil => 308 return R_None; 309 when Mode_X1 310 | Mode_Blk => 311 raise Program_Error; 312 end case; 313 end Get_Return_Register; 314 315 function Insert_Move (Expr : O_Enode; Dest : O_Reg) return O_Enode 316 is 317 N : O_Enode; 318 begin 319 N := New_Enode (OE_Move, Get_Expr_Mode (Expr), O_Tnode_Null, 320 Expr, O_Enode_Null); 321 Set_Expr_Reg (N, Dest); 322 Link_Stmt (N); 323 return N; 324 end Insert_Move; 325 326 procedure Error_Gen_Insn (Stmt : O_Enode; Reg : O_Reg); 327 procedure Error_Gen_Insn (Stmt : O_Enode; Mode : Mode_Type); 328 pragma No_Return (Error_Gen_Insn); 329 330 procedure Error_Gen_Insn (Stmt : O_Enode; Reg : O_Reg) 331 is 332 use Ada.Text_IO; 333 begin 334 Put_Line ("gen_insn error: cannot match reg " & Abi.Image_Reg (Reg) 335 & " with stmt " & OE_Kind'Image (Get_Expr_Kind (Stmt))); 336 raise Program_Error; 337 end Error_Gen_Insn; 338 339 procedure Error_Gen_Insn (Stmt : O_Enode; Mode : Mode_Type) 340 is 341 use Ada.Text_IO; 342 begin 343 Put_Line ("gen_insn error: cannot match mode " & Mode_Type'Image (Mode) 344 & " with stmt " & OE_Kind'Image (Get_Expr_Kind (Stmt)) 345 & " of mode " & Mode_Type'Image (Get_Expr_Mode (Stmt))); 346 raise Program_Error; 347 end Error_Gen_Insn; 348 349 Cur_Block : O_Enode; 350 351 type O_Inum is new Int32; 352 O_Free : constant O_Inum := 0; 353 O_Iroot : constant O_Inum := 1; 354 355 Insn_Num : O_Inum; 356 357 function Get_Insn_Num return O_Inum is 358 begin 359 Insn_Num := Insn_Num + 1; 360 return Insn_Num; 361 end Get_Insn_Num; 362 363 type Reg_Info_Type is record 364 -- Statement number which use this register. 365 -- This is a distance. 366 Num : O_Inum; 367 368 -- Statement which produces this value. 369 -- Used to have more info on this register (such as mode to allocate 370 -- a spill location). 371 Stmt : O_Enode; 372 373 -- If set, this register has been used. 374 -- All callee-saved registers marked 'used' must be saved in the prolog. 375 Used : Boolean; 376 end record; 377 pragma Suppress_Initialization (Reg_Info_Type); -- Not needed. 378 379 Init_Reg_Info : constant Reg_Info_Type := (Num => O_Free, 380 Stmt => O_Enode_Null, 381 Used => False); 382 type RegGp_Info_Array is array (Regs_R64) of Reg_Info_Type; 383 pragma Suppress_Initialization (RegGp_Info_Array); -- Not needed. 384 Regs : RegGp_Info_Array := (others => Init_Reg_Info); 385 386 Reg_Cc : Reg_Info_Type := Init_Reg_Info; 387 388 type Fp_Stack_Type is mod 8; 389 type RegFp_Info_Array is array (Fp_Stack_Type) of Reg_Info_Type; 390 pragma Suppress_Initialization (RegFp_Info_Array); -- Not needed. 391 Fp_Top : Fp_Stack_Type := 0; 392 Fp_Regs : RegFp_Info_Array; 393 394 type Reg_Xmm_Info_Array is array (Regs_Xmm) of Reg_Info_Type; 395 pragma Suppress_Initialization (Reg_Xmm_Info_Array); -- Not needed. 396 Xmm_Regs : Reg_Xmm_Info_Array := (others => Init_Reg_Info); 397 398 function Reg_Used (Reg : Regs_R64) return Boolean is 399 begin 400 return Regs (Reg).Used; 401 end Reg_Used; 402 403 procedure Dump_Reg32_Info (Reg : Regs_R64) 404 is 405 use Ada.Text_IO; 406 use Ortho_Code.Debug.Int32_IO; 407 use Abi; 408 begin 409 Put (Image_Reg (Reg)); 410 Put (": "); 411 Put (Int32 (Regs (Reg).Stmt), 0); 412 Put (", num: "); 413 Put (Int32 (Regs (Reg).Num), 0); 414 --Put (", twin: "); 415 --Put (Image_Reg (Regs (Reg).Twin_Reg)); 416 --Put (", link: "); 417 --Put (Image_Reg (Regs (Reg).Link)); 418 New_Line; 419 end Dump_Reg32_Info; 420 421 procedure Dump_Regs 422 is 423 use Ada.Text_IO; 424 use Debug.Int32_IO; 425 begin 426-- Put ("free_regs: "); 427-- Put (Image_Reg (Free_Regs)); 428-- Put (", to_free_regs: "); 429-- Put (Image_Reg (To_Free_Regs)); 430-- New_Line; 431 432 for I in Regs_R32 loop 433 Dump_Reg32_Info (I); 434 end loop; 435 if Flags.M64 then 436 for I in Regs_R8_R15 loop 437 Dump_Reg32_Info (I); 438 end loop; 439 end if; 440 if not Abi.Flag_Sse2 then 441 for I in Fp_Stack_Type loop 442 Put ("fp" & Fp_Stack_Type'Image (I)); 443 Put (": "); 444 Put (Int32 (Fp_Regs (I).Stmt), 0); 445 New_Line; 446 end loop; 447 end if; 448 end Dump_Regs; 449 450 pragma Unreferenced (Dump_Regs); 451 452 procedure Error_Reg (Msg : String; Stmt : O_Enode; Reg : O_Reg); 453 pragma No_Return (Error_Reg); 454 455 procedure Error_Reg (Msg : String; Stmt : O_Enode; Reg : O_Reg) 456 is 457 use Ada.Text_IO; 458 use Ortho_Code.Debug.Int32_IO; 459 begin 460 Put ("error reg: "); 461 Put (Msg); 462 New_Line; 463 Put (" stmt: "); 464 Put (Int32 (Stmt), 0); 465 Put (", reg: "); 466 Put (Abi.Image_Reg (Reg)); 467 New_Line; 468 --Dump_Regs; 469 raise Program_Error; 470 end Error_Reg; 471 472 -- Free_XX 473 -- Mark a register as unused. 474 procedure Free_Gp (Reg : O_Reg) is 475 begin 476 pragma Assert (Regs (Reg).Num /= O_Free); 477 Regs (Reg).Num := O_Free; 478 end Free_Gp; 479 480 procedure Free_Fp is 481 begin 482 pragma Assert (not Abi.Flag_Sse2); 483 pragma Assert (Fp_Regs (Fp_Top).Num /= O_Free); 484 Fp_Regs (Fp_Top).Num := O_Free; 485 Fp_Top := Fp_Top + 1; 486 end Free_Fp; 487 488 procedure Free_Cc is 489 begin 490 pragma Assert (Reg_Cc.Num /= O_Free); 491 Reg_Cc.Num := O_Free; 492 end Free_Cc; 493 494 procedure Free_Xmm (Reg : O_Reg) is 495 begin 496 pragma Assert (Xmm_Regs (Reg).Num /= O_Free); 497 Xmm_Regs (Reg).Num := O_Free; 498 end Free_Xmm; 499 500 -- Allocate a stack slot for spilling. 501 procedure Alloc_Spill (N : O_Enode) 502 is 503 Mode : constant Mode_Type := Get_Expr_Mode (N); 504 begin 505 -- Allocate on the stack. 506 Stack_Offset := Types.Do_Align (Stack_Offset, Mode); 507 Stack_Offset := Stack_Offset + Types.Get_Mode_Size (Mode); 508 if Stack_Offset > Stack_Max then 509 Stack_Max := Stack_Offset; 510 end if; 511 Set_Spill_Info (N, -Int32 (Stack_Offset)); 512 end Alloc_Spill; 513 514 -- Insert a spill statement after ORIG: will save register(s) allocated by 515 -- ORIG. 516 -- Return the register(s) spilt (There might be several registers if 517 -- ORIG uses a R64 register). 518 function Insert_Spill (Orig : O_Enode) return O_Reg 519 is 520 Mode : constant Mode_Type := Get_Expr_Mode (Orig); 521 N : O_Enode; 522 Reg_Orig : O_Reg; 523 begin 524 -- Add a spill statement. 525 N := New_Enode (OE_Spill, Mode, O_Tnode_Null, Orig, O_Enode_Null); 526 Alloc_Spill (N); 527 528 -- Insert the statement after the one that set the register 529 -- being spilled. 530 -- That's very important to be able to easily find the spill location, 531 -- when it will be reloaded. 532 if Orig = Abi.Last_Link then 533 Link_Stmt (N); 534 else 535 Set_Stmt_Link (N, Get_Stmt_Link (Orig)); 536 Set_Stmt_Link (Orig, N); 537 end if; 538 539 -- Mark the target of the original expression as split (so that it is 540 -- marked as to be reloaded), and save the register in the spill insn. 541 Reg_Orig := Get_Expr_Reg (Orig); 542 Set_Expr_Reg (N, Reg_Orig); 543 Set_Expr_Reg (Orig, R_Spill); 544 return Reg_Orig; 545 end Insert_Spill; 546 547 procedure Spill_Gp (Reg : Regs_R64) 548 is 549 Reg_Orig : O_Reg; 550 begin 551 -- This register was not allocated. 552 pragma Assert (Regs (Reg).Num /= O_Free); 553 554 Reg_Orig := Insert_Spill (Regs (Reg).Stmt); 555 556 -- Free the register. 557 case Reg_Orig is 558 when Regs_R64 => 559 pragma Assert (Reg_Orig = Reg); 560 Free_Gp (Reg); 561 when Regs_Pair => 562 pragma Assert (not Flags.M64); 563 -- The pair was spilled, so the pair is free. 564 Free_Gp (Get_Pair_High (Reg_Orig)); 565 Free_Gp (Get_Pair_Low (Reg_Orig)); 566 when others => 567 raise Program_Error; 568 end case; 569 end Spill_Gp; 570 571 procedure Alloc_Gp (Reg : Regs_R64; Stmt : O_Enode; Num : O_Inum) is 572 begin 573 if Regs (Reg).Num /= O_Free then 574 Spill_Gp (Reg); 575 end if; 576 Regs (Reg) := (Num => Num, Stmt => Stmt, Used => True); 577 end Alloc_Gp; 578 579 procedure Clobber_Gp (Reg : O_Reg) is 580 begin 581 if Regs (Reg).Num /= O_Free then 582 Spill_Gp (Reg); 583 end if; 584 end Clobber_Gp; 585 586 procedure Alloc_Fp (Stmt : O_Enode) is 587 begin 588 pragma Assert (not Abi.Flag_Sse2); 589 590 Fp_Top := Fp_Top - 1; 591 592 if Fp_Regs (Fp_Top).Stmt /= O_Enode_Null then 593 -- Must spill-out. 594 raise Program_Error; 595 end if; 596 Fp_Regs (Fp_Top).Stmt := Stmt; 597 end Alloc_Fp; 598 599 procedure Alloc_Pair (Reg : O_Reg; Stmt : O_Enode; Num : O_Inum) 600 is 601 pragma Assert (not Flags.M64); 602 Rl : constant O_Reg := Get_Pair_Low (Reg); 603 Rh : constant O_Reg := Get_Pair_High (Reg); 604 begin 605 if Regs (Rl).Num /= O_Free 606 or Regs (Rh).Num /= O_Free 607 then 608 Spill_Gp (Rl); 609 end if; 610 Regs (Rh) := (Num => Num, Stmt => Stmt, Used => True); 611 Regs (Rl) := (Num => Num, Stmt => Stmt, Used => True); 612 end Alloc_Pair; 613 614 procedure Alloc_Cc (Stmt : O_Enode; Num : O_Inum) is 615 begin 616 pragma Assert (Reg_Cc.Num = O_Free); 617 Reg_Cc := (Num => Num, Stmt => Stmt, Used => True); 618 end Alloc_Cc; 619 620 procedure Spill_Xmm (Reg : Regs_Xmm) 621 is 622 Reg_Orig : O_Reg; 623 begin 624 -- This register was not allocated. 625 pragma Assert (Xmm_Regs (Reg).Num /= O_Free); 626 627 Reg_Orig := Insert_Spill (Xmm_Regs (Reg).Stmt); 628 629 -- Free the register. 630 pragma Assert (Reg_Orig = Reg); 631 Free_Xmm (Reg); 632 end Spill_Xmm; 633 634 procedure Alloc_Xmm (Reg : Regs_Xmm; Stmt : O_Enode; Num : O_Inum) is 635 begin 636 if Xmm_Regs (Reg).Num /= O_Free then 637 Spill_Xmm (Reg); 638 end if; 639 Xmm_Regs (Reg) := (Num => Num, Stmt => Stmt, Used => True); 640 end Alloc_Xmm; 641 642 procedure Clobber_Xmm (Reg : Regs_Xmm) is 643 begin 644 if Xmm_Regs (Reg).Num /= O_Free then 645 Spill_Xmm (Reg); 646 end if; 647 end Clobber_Xmm; 648 649 function Alloc_Reg (Reg : O_Reg; Stmt : O_Enode; Num : O_Inum) return O_Reg 650 is 651 Last_Reg : O_Reg; 652 Best_Reg : O_Reg; 653 Best_Num : O_Inum; 654 begin 655 case Reg is 656 when Regs_R64 => 657 Alloc_Gp (Reg, Stmt, Num); 658 return Reg; 659 when Regs_Pair => 660 pragma Assert (not Flags.M64); 661 Alloc_Pair (Reg, Stmt, Num); 662 return Reg; 663 when R_St0 => 664 pragma Assert (not Abi.Flag_Sse2); 665 Alloc_Fp (Stmt); 666 return Reg; 667 when Regs_Xmm => 668 Alloc_Xmm (Reg, Stmt, Num); 669 return Reg; 670 when R_Any8 671 | R_Any32 672 | R_Any64 => 673 if Flags.M64 then 674 Last_Reg := R_R15; 675 else 676 if Reg = R_Any8 then 677 Last_Reg := R_Bx; 678 else 679 Last_Reg := R_Di; 680 end if; 681 end if; 682 Best_Num := O_Inum'Last; 683 Best_Reg := R_None; 684 for I in R_Ax .. Last_Reg loop 685 if I not in R_Sp .. R_Bp then 686 if Regs (I).Num = O_Free then 687 Alloc_Gp (I, Stmt, Num); 688 return I; 689 elsif Regs (I).Num <= Best_Num then 690 Best_Reg := I; 691 Best_Num := Regs (I).Num; 692 end if; 693 end if; 694 end loop; 695 Alloc_Gp (Best_Reg, Stmt, Num); 696 return Best_Reg; 697 when R_AnyPair => 698 pragma Assert (not Flags.M64); 699 declare 700 Rh, Rl : O_Reg; 701 begin 702 Best_Num := O_Inum'Last; 703 Best_Reg := R_None; 704 for I in Regs_Pair loop 705 Rh := Get_Pair_High (I); 706 Rl := Get_Pair_Low (I); 707 if Regs (Rh).Num = O_Free 708 and then Regs (Rl).Num = O_Free 709 then 710 Alloc_Pair (I, Stmt, Num); 711 return I; 712 elsif Regs (Rh).Num <= Best_Num 713 and Regs (Rl).Num <= Best_Num 714 then 715 Best_Reg := I; 716 Best_Num := O_Inum'Max (Regs (Rh).Num, 717 Regs (Rl).Num); 718 end if; 719 end loop; 720 Alloc_Pair (Best_Reg, Stmt, Num); 721 return Best_Reg; 722 end; 723 when R_Any_Xmm => 724 Best_Num := O_Inum'Last; 725 Best_Reg := R_None; 726 for I in Regs_X86_Xmm loop 727 if Xmm_Regs (I).Num = O_Free then 728 Alloc_Xmm (I, Stmt, Num); 729 return I; 730 elsif Xmm_Regs (I).Num <= Best_Num then 731 Best_Reg := I; 732 Best_Num := Xmm_Regs (I).Num; 733 end if; 734 end loop; 735 Alloc_Xmm (Best_Reg, Stmt, Num); 736 return Best_Reg; 737 when others => 738 Error_Reg ("alloc_reg: unknown reg", O_Enode_Null, Reg); 739 raise Program_Error; 740 end case; 741 end Alloc_Reg; 742 743 function Gen_Reload (Spill : O_Enode; Reg : O_Reg; Num : O_Inum) 744 return O_Enode 745 is 746 Mode : constant Mode_Type := Get_Expr_Mode (Spill); 747 N : O_Enode; 748 begin 749 -- Add a reload node. 750 N := New_Enode (OE_Reload, Mode, O_Tnode_Null, Spill, O_Enode_Null); 751 -- Note: this does not use a just-freed register, since 752 -- this case only occurs at the first call. 753 Set_Expr_Reg (N, Alloc_Reg (Reg, N, Num)); 754 Link_Stmt (N); 755 return N; 756 end Gen_Reload; 757 758 function Reload (Expr : O_Enode; Dest : O_Reg; Num : O_Inum) return O_Enode 759 is 760 Reg : constant O_Reg := Get_Expr_Reg (Expr); 761 Spill : O_Enode; 762 begin 763 case Reg is 764 when R_Spill => 765 -- Restore the register between the statement and the spill. 766 Spill := Get_Stmt_Link (Expr); 767 Set_Expr_Reg (Expr, Get_Expr_Reg (Spill)); 768 Set_Expr_Reg (Spill, R_Spill); 769 case Dest is 770 when R_Mem 771 | R_Irm 772 | R_Rm => 773 -- Some instructions can do the reload by themself. 774 return Spill; 775 when Regs_R64 776 | R_Any64 777 | R_Any32 778 | R_Any8 779 | R_AnyPair 780 | Regs_Pair 781 | Regs_Xmm 782 | R_Any_Xmm => 783 return Gen_Reload (Spill, Dest, Num); 784 when R_Sib => 785 return Gen_Reload (Spill, R_Any32, Num); 786 when R_Ir => 787 return Gen_Reload (Spill, Get_Reg_Any (Expr), Num); 788 when others => 789 Error_Reg ("reload: unhandled dest in spill", Expr, Dest); 790 end case; 791 when Regs_R64 => 792 case Dest is 793 when R_Irm 794 | R_Rm 795 | R_Ir 796 | R_Any64 797 | R_Any32 798 | R_Any8 799 | R_Sib => 800 return Expr; 801 when Regs_R64 => 802 if Dest = Reg then 803 return Expr; 804 end if; 805 if Reg /= R_Bp then 806 -- Never free BP as it is not allocated (fixed register). 807 -- BP can be referenced by OE_Get_Frame. 808 Free_Gp (Reg); 809 end if; 810 Spill := Insert_Move (Expr, Dest); 811 Alloc_Gp (Dest, Spill, Num); 812 return Spill; 813 when others => 814 Error_Reg ("reload: unhandled dest in R32", Expr, Dest); 815 end case; 816 when Regs_Pair => 817 pragma Assert (not Flags.M64); 818 return Expr; 819 when R_St0 => 820 pragma Assert (not Abi.Flag_Sse2); 821 return Expr; 822 when Regs_Xmm => 823 return Expr; 824 when R_Mem => 825 if Get_Expr_Kind (Expr) = OE_Indir then 826 Set_Expr_Operand (Expr, 827 Reload (Get_Expr_Operand (Expr), R_Sib, Num)); 828 return Expr; 829 else 830 raise Program_Error; 831 end if; 832 when R_B_Off 833 | R_B_I 834 | R_I_Off 835 | R_Sib => 836 case Get_Expr_Kind (Expr) is 837 when OE_Add => 838 Set_Expr_Left 839 (Expr, Reload (Get_Expr_Left (Expr), R_Any32, Num)); 840 Set_Expr_Right 841 (Expr, Reload (Get_Expr_Right (Expr), R_Any32, Num)); 842 return Expr; 843 when OE_Addrl => 844 Spill := Get_Addrl_Frame (Expr); 845 if Spill /= O_Enode_Null then 846 Set_Addrl_Frame (Expr, Reload (Spill, R_Any32, Num)); 847 end if; 848 return Expr; 849 when OE_Addrd => 850 return Expr; 851 when others => 852 Error_Reg ("reload: unhandle expr in b_off", Expr, Dest); 853 end case; 854 when R_I => 855 Set_Expr_Left (Expr, Reload (Get_Expr_Left (Expr), R_Any32, Num)); 856 return Expr; 857 when R_Imm => 858 return Expr; 859 when others => 860 Error_Reg ("reload: unhandled reg", Expr, Reg); 861 end case; 862 end Reload; 863 864 procedure Renum_Reg (Reg : O_Reg; Stmt : O_Enode; Num : O_Inum) is 865 begin 866 case Reg is 867 when Regs_R64 => 868 Regs (Reg).Num := Num; 869 Regs (Reg).Stmt := Stmt; 870 when Regs_Cc => 871 Reg_Cc.Num := Num; 872 Reg_Cc.Stmt := Stmt; 873 when R_St0 => 874 pragma Assert (not Abi.Flag_Sse2); 875 null; 876 when Regs_Xmm => 877 Xmm_Regs (Reg).Num := Num; 878 Xmm_Regs (Reg).Stmt := Stmt; 879 when Regs_Pair => 880 pragma Assert (not Flags.M64); 881 declare 882 L, H : O_Reg; 883 begin 884 L := Get_Pair_Low (Reg); 885 Regs (L).Num := Num; 886 Regs (L).Stmt := Stmt; 887 H := Get_Pair_High (Reg); 888 Regs (H).Num := Num; 889 Regs (H).Stmt := Stmt; 890 end; 891 when others => 892 Error_Reg ("renum_reg", Stmt, Reg); 893 end case; 894 end Renum_Reg; 895 896 procedure Free_Insn_Regs (Insn : O_Enode) 897 is 898 R : constant O_Reg := Get_Expr_Reg (Insn); 899 begin 900 case R is 901 when R_Ax 902 | R_Bx 903 | R_Cx 904 | R_Dx 905 | R_Si 906 | R_Di 907 | Regs_R8_R15 => 908 Free_Gp (R); 909 when R_Sp 910 | R_Bp => 911 null; 912 when R_St0 => 913 pragma Assert (not Abi.Flag_Sse2); 914 Free_Fp; 915 when Regs_Xmm => 916 Free_Xmm (R); 917 when Regs_Pair => 918 pragma Assert (not Flags.M64); 919 Free_Gp (Get_Pair_High (R)); 920 Free_Gp (Get_Pair_Low (R)); 921 when R_Mem => 922 if Get_Expr_Kind (Insn) = OE_Indir then 923 Free_Insn_Regs (Get_Expr_Operand (Insn)); 924 else 925 raise Program_Error; 926 end if; 927 when R_B_Off 928 | R_B_I 929 | R_I_Off 930 | R_Sib => 931 case Get_Expr_Kind (Insn) is 932 when OE_Add => 933 Free_Insn_Regs (Get_Expr_Left (Insn)); 934 Free_Insn_Regs (Get_Expr_Right (Insn)); 935 when OE_Addrl => 936 if Get_Addrl_Frame (Insn) /= O_Enode_Null then 937 Free_Insn_Regs (Get_Addrl_Frame (Insn)); 938 end if; 939 when OE_Addrd => 940 -- RIP-relative, no reg to free. 941 null; 942 when others => 943 raise Program_Error; 944 end case; 945 when R_I => 946 Free_Insn_Regs (Get_Expr_Left (Insn)); 947 when R_Imm => 948 null; 949 when R_Spill => 950 null; 951 when others => 952 Error_Reg ("free_insn_regs: unknown reg", Insn, R); 953 end case; 954 end Free_Insn_Regs; 955 956 procedure Insert_Reg (Mode : Mode_Type) 957 is 958 pragma Assert (not Flags.M64); 959 N : O_Enode; 960 Num : O_Inum; 961 begin 962 Num := Get_Insn_Num; 963 N := New_Enode (OE_Reg, Mode, O_Tnode_Null, 964 O_Enode_Null, O_Enode_Null); 965 Set_Expr_Reg (N, Alloc_Reg (Get_Reg_Any (Mode), N, Num)); 966 Link_Stmt (N); 967 Free_Insn_Regs (N); 968 end Insert_Reg; 969 970 -- REG is mandatory: the result of STMT must satisfy the REG constraint. 971 function Gen_Insn (Stmt : O_Enode; Reg : O_Reg; Pnum : O_Inum) 972 return O_Enode; 973 974 function Gen_Conv_From_Fp_Insn (Stmt : O_Enode; 975 Reg : O_Reg; 976 Pnum : O_Inum) 977 return O_Enode 978 is 979 Left : O_Enode; 980 Num : O_Inum; 981 begin 982 if not Flags.M64 then 983 -- Need a temporary to work. Always use FPU. 984 Need_Fp_Conv_Slot := True; 985 end if; 986 Num := Get_Insn_Num; 987 Left := Get_Expr_Operand (Stmt); 988 Left := Gen_Insn (Left, Get_Reg_Any (Left), Num); 989 Free_Insn_Regs (Left); 990 Set_Expr_Operand (Stmt, Left); 991 case Reg is 992 when R_Any32 993 | Regs_R64 994 | R_Any64 995 | Regs_Pair 996 | R_AnyPair => 997 Set_Expr_Reg (Stmt, Alloc_Reg (Reg, Stmt, Pnum)); 998 when R_Rm 999 | R_Irm 1000 | R_Ir => 1001 Set_Expr_Reg (Stmt, Alloc_Reg (Get_Reg_Any (Stmt), Stmt, Pnum)); 1002 when others => 1003 raise Program_Error; 1004 end case; 1005 Link_Stmt (Stmt); 1006 return Stmt; 1007 end Gen_Conv_From_Fp_Insn; 1008 1009 -- Mark all registers that aren't preserved by a call as clobbered, so that 1010 -- they are saved. 1011 procedure Clobber_Caller_Saved_Registers_32 1012 is 1013 pragma Assert (not Flags.M64); 1014 begin 1015 Clobber_Gp (R_Ax); 1016 Clobber_Gp (R_Dx); 1017 Clobber_Gp (R_Cx); 1018 -- FIXME: fp regs. 1019 1020 if Abi.Flag_Sse2 then 1021 for R in Regs_Xmm loop 1022 Clobber_Xmm (R); 1023 end loop; 1024 end if; 1025 end Clobber_Caller_Saved_Registers_32; 1026 1027 procedure Clobber_Caller_Saved_Registers_64 1028 (First_Arg : O_Enode; Subprg : O_Dnode; Num : O_Inum) 1029 is 1030 pragma Assert (Flags.M64); 1031 Inter : O_Dnode; 1032 Arg : O_Enode; 1033 Expr : O_Enode; 1034 Reg : O_Reg; 1035 T : O_Enode; 1036 begin 1037 -- Reload all parameters passed in registers and free regs. 1038 Inter := Get_Subprg_Interfaces (Subprg); 1039 Arg := First_Arg; 1040 while Inter /= O_Dnode_Null loop 1041 Reg := Get_Decl_Reg (Inter); 1042 if Reg /= R_None then 1043 Expr := Get_Expr_Operand (Arg); 1044 T := Reload (Expr, Reg, Num); 1045 Free_Insn_Regs (T); 1046 end if; 1047 Inter := Get_Interface_Chain (Inter); 1048 Arg := Get_Arg_Link (Arg); 1049 end loop; 1050 1051 -- Mark caller saved registers as clobbered. 1052 if Flags.Win64 then 1053 -- R12-R15, RSI, RDI, RBX, RBP are preserved by callee. 1054 for R in Preserved_Regs_Win64'Range loop 1055 if not Preserved_Regs_Win64 (R) then 1056 Clobber_Gp (R); 1057 end if; 1058 end loop; 1059 else 1060 -- RBX, R12-R15 are callee-saved (preserved) 1061 for R in Preserved_Regs_Lin64'Range loop 1062 if not Preserved_Regs_Lin64 (R) then 1063 Clobber_Gp (R); 1064 end if; 1065 end loop; 1066 end if; 1067 1068 if Flags.Win64 then 1069 -- Xmm6 - xmm15 are preserved. 1070 for R in Preserved_Xmm_Win64'Range loop 1071 if not Preserved_Xmm_Win64 (R) then 1072 Clobber_Xmm (R); 1073 end if; 1074 end loop; 1075 else 1076 -- All Xmm registers are for arguments or volatile. 1077 for R in Regs_Xmm loop 1078 Clobber_Xmm (R); 1079 end loop; 1080 end if; 1081 end Clobber_Caller_Saved_Registers_64; 1082 1083 -- Insert an argument for an intrinsic call. 1084 procedure Insert_Arg (Expr : O_Enode) 1085 is 1086 pragma Assert (not Flags.M64); 1087 N : O_Enode; 1088 begin 1089 Free_Insn_Regs (Expr); 1090 N := New_Enode (OE_Arg, Get_Expr_Mode (Expr), O_Tnode_Null, 1091 Expr, O_Enode_Null); 1092 Set_Expr_Reg (N, R_None); 1093 Link_Stmt (N); 1094 end Insert_Arg; 1095 1096 -- Insert a call to an instrinsic (a libgcc helper). 1097 function Insert_Intrinsic (Stmt : O_Enode; Reg : O_Reg; Num : O_Inum) 1098 return O_Enode 1099 is 1100 pragma Assert (not Flags.M64); 1101 Mode : constant Mode_Type := Get_Expr_Mode (Stmt); 1102 N : O_Enode; 1103 Op : Int32; 1104 begin 1105 case Get_Expr_Kind (Stmt) is 1106 when OE_Mul_Ov => 1107 case Mode is 1108 when Mode_U64 => 1109 Op := Intrinsic_Mul_Ov_U64; 1110 when Mode_I64 => 1111 Op := Intrinsic_Mul_Ov_I64; 1112 when others => 1113 raise Program_Error; 1114 end case; 1115 when OE_Div_Ov => 1116 case Mode is 1117 when Mode_U64 => 1118 Op := Intrinsic_Div_Ov_U64; 1119 when Mode_I64 => 1120 Op := Intrinsic_Div_Ov_I64; 1121 when others => 1122 raise Program_Error; 1123 end case; 1124 when OE_Mod => 1125 case Mode is 1126 when Mode_U64 => 1127 Op := Intrinsic_Mod_Ov_U64; 1128 when Mode_I64 => 1129 Op := Intrinsic_Mod_Ov_I64; 1130 when others => 1131 raise Program_Error; 1132 end case; 1133 when OE_Rem => 1134 case Mode is 1135 when Mode_U64 => 1136 -- For unsigned, MOD == REM. 1137 Op := Intrinsic_Mod_Ov_U64; 1138 when Mode_I64 => 1139 Op := Intrinsic_Rem_Ov_I64; 1140 when others => 1141 raise Program_Error; 1142 end case; 1143 when others => 1144 raise Program_Error; 1145 end case; 1146 1147 -- Save caller-saved registers. 1148 Clobber_Caller_Saved_Registers_32; 1149 1150 N := New_Enode (OE_Intrinsic, Mode, O_Tnode_Null, 1151 O_Enode (Op), O_Enode_Null); 1152 Set_Expr_Reg (N, Alloc_Reg (Reg, N, Num)); 1153 Link_Stmt (N); 1154 return N; 1155 end Insert_Intrinsic; 1156 1157 procedure Gen_Stack_Adjust (Off : Int32) 1158 is 1159 use Ortho_Code.Abi; 1160 Stmt : O_Enode; 1161 begin 1162 if Get_Expr_Kind (Last_Link) = OE_Stack_Adjust then 1163 -- The last instruction was already a stack_adjust. Change the 1164 -- value. 1165 Set_Stack_Adjust (Last_Link, 1166 Get_Stack_Adjust (Last_Link) + Off); 1167 if Debug.Flag_Debug_Insn then 1168 Ada.Text_IO.Put (" patched:"); 1169 Disp_Stmt (Last_Link); 1170 end if; 1171 else 1172 Stmt := New_Enode (OE_Stack_Adjust, Mode_Nil, O_Tnode_Null, 1173 O_Enode (Off), O_Enode_Null); 1174 Link_Stmt (Stmt); 1175 end if; 1176 end Gen_Stack_Adjust; 1177 1178 procedure Gen_Call_Arg (Arg : O_Enode; Inter : O_Dnode; Pnum : O_Inum) 1179 is 1180 begin 1181 if Arg = O_Enode_Null then 1182 -- End of args. 1183 pragma Assert (Inter = O_Dnode_Null); 1184 return; 1185 else 1186 -- Recurse on next argument, so the first argument is pushed 1187 -- the last one. 1188 pragma Assert (Inter /= O_Dnode_Null); 1189 Gen_Call_Arg (Get_Arg_Link (Arg), Get_Interface_Chain (Inter), Pnum); 1190 end if; 1191 1192 declare 1193 Inter_Reg : constant O_Reg := Get_Decl_Reg (Inter); 1194 Reg : O_Reg; 1195 Expr : O_Enode; 1196 begin 1197 Expr := Get_Expr_Operand (Arg); 1198 if Inter_Reg = R_None then 1199 -- On the stack. 1200 case Get_Expr_Mode (Expr) is 1201 when Mode_F32 .. Mode_F64 => 1202 -- fstp instruction. 1203 if Abi.Flag_Sse2 then 1204 Reg := R_Any_Xmm; 1205 else 1206 Reg := R_St0; 1207 end if; 1208 when others => 1209 -- Push instruction. 1210 Reg := R_Irm; 1211 end case; 1212 else 1213 Reg := Inter_Reg; 1214 end if; 1215 Expr := Gen_Insn (Expr, Reg, Pnum); 1216 Set_Expr_Operand (Arg, Expr); 1217 if Inter_Reg = R_None then 1218 -- Link the OE_Arg code (it will be translated as a push). 1219 Link_Stmt (Arg); 1220 -- Use Mode_Ptr for a 32 or 64 bit word. 1221 Push_Offset := Push_Offset + 1222 Do_Align (Get_Mode_Size (Get_Expr_Mode (Expr)), Abi.Mode_Ptr); 1223 Free_Insn_Regs (Expr); 1224 end if; 1225 end; 1226 end Gen_Call_Arg; 1227 1228 function Gen_Call (Stmt : O_Enode; Reg : O_Reg; Pnum : O_Inum) 1229 return O_Enode 1230 is 1231 use Interfaces; 1232 Subprg : constant O_Dnode := Get_Call_Subprg (Stmt); 1233 Push_Size : constant Uns32 := Uns32 (Get_Subprg_Stack (Subprg)); 1234 Reg_Res : O_Reg; 1235 Pad : Uns32; 1236 Res_Stmt : O_Enode; 1237 begin 1238 -- Emit Setup_Frame (to align stack). 1239 -- Pad the stack if necessary (this may be a nested call). 1240 Pad := (Push_Size + Push_Offset) and Uns32 (Flags.Stack_Boundary - 1); 1241 if Pad /= 0 then 1242 Pad := Uns32 (Flags.Stack_Boundary) - Pad; 1243 Gen_Stack_Adjust (Int32 (Pad)); 1244 end if; 1245 -- The stack has been adjusted by Pad bytes. 1246 Push_Offset := Push_Offset + Pad; 1247 1248 -- Generate code for arguments (if any). 1249 Gen_Call_Arg (Get_Arg_Link (Stmt), Get_Subprg_Interfaces (Subprg), Pnum); 1250 1251 -- Clobber registers. They are saved in reserved slots (at the top 1252 -- of the frame). 1253 if Flags.M64 then 1254 Clobber_Caller_Saved_Registers_64 (Get_Arg_Link (Stmt), Subprg, Pnum); 1255 else 1256 Clobber_Caller_Saved_Registers_32; 1257 end if; 1258 1259 -- Add the call. 1260 Reg_Res := Get_Return_Register (Get_Expr_Mode (Stmt)); 1261 Set_Expr_Reg (Stmt, Reg_Res); 1262 Link_Stmt (Stmt); 1263 Res_Stmt := Stmt; 1264 1265 if Push_Size + Pad /= 0 then 1266 Gen_Stack_Adjust (-Int32 (Push_Size + Pad)); 1267 1268 -- The stack has been restored (just after the call). 1269 Push_Offset := Push_Offset - (Push_Size + Pad); 1270 end if; 1271 1272 case Reg is 1273 when R_Any32 1274 | R_Any64 1275 | R_AnyPair 1276 | R_Any8 1277 | R_Any_Xmm 1278 | R_Irm 1279 | R_Rm 1280 | R_Ir 1281 | R_Sib 1282 | R_St0 1283 | R_Edx_Eax => 1284 Reg_Res := Alloc_Reg (Reg_Res, Res_Stmt, Pnum); 1285 return Res_Stmt; 1286 when Regs_R64 => 1287 if Reg /= Reg_Res then 1288 Res_Stmt := Insert_Move (Res_Stmt, Reg); 1289 end if; 1290 Alloc_Gp (Reg, Res_Stmt, Pnum); 1291 return Res_Stmt; 1292 when Regs_Xmm => 1293 if Reg /= Reg_Res then 1294 Res_Stmt := Insert_Move (Res_Stmt, Reg); 1295 end if; 1296 Alloc_Xmm (Reg, Res_Stmt, Pnum); 1297 return Res_Stmt; 1298 when R_Any_Cc => 1299 -- Move to register. 1300 -- (use the 'test' instruction). 1301 Alloc_Cc (Res_Stmt, Pnum); 1302 return Insert_Move (Res_Stmt, R_Ne); 1303 when R_None => 1304 pragma Assert (Reg_Res = R_None); 1305 return Res_Stmt; 1306 when others => 1307 Error_Gen_Insn (Stmt, Reg); 1308 end case; 1309 end Gen_Call; 1310 1311 function Gen_Insn (Stmt : O_Enode; Reg : O_Reg; Pnum : O_Inum) 1312 return O_Enode 1313 is 1314 Kind : constant OE_Kind := Get_Expr_Kind (Stmt); 1315 1316 Left : O_Enode; 1317 Right : O_Enode; 1318 Res : O_Enode; 1319 1320 Reg1 : O_Reg; 1321 -- P_Reg : O_Reg; 1322 Reg_L : O_Reg; 1323 Reg_Res : O_Reg; 1324 1325 Num : O_Inum; 1326 begin 1327 case Kind is 1328 when OE_Addrl => 1329 Right := Get_Addrl_Frame (Stmt); 1330 if Right /= O_Enode_Null then 1331 -- Outer frame. 1332 Num := Get_Insn_Num; 1333 Right := Gen_Insn (Right, R_Any64, Num); 1334 Set_Addrl_Frame (Stmt, Right); 1335 else 1336 Num := O_Free; 1337 end if; 1338 case Reg is 1339 when R_Sib => 1340 Set_Expr_Reg (Stmt, R_B_Off); 1341 return Stmt; 1342 when R_Irm 1343 | R_Ir 1344 | Regs_R64 => 1345 if Right /= O_Enode_Null then 1346 Free_Insn_Regs (Right); 1347 end if; 1348 if Reg in Regs_R64 then 1349 Reg1 := Reg; 1350 else 1351 Reg1 := R_Any64; 1352 end if; 1353 Set_Expr_Reg (Stmt, Alloc_Reg (Reg1, Stmt, Pnum)); 1354 Link_Stmt (Stmt); 1355 return Stmt; 1356 when others => 1357 Error_Gen_Insn (Stmt, Reg); 1358 end case; 1359 when OE_Addrd => 1360 if Flags.M64 then 1361 -- Use RIP-Relative addressing. 1362 if Reg = R_Sib 1363 and then not Is_External_Object (Get_Addr_Decl (Stmt)) 1364 then 1365 Set_Expr_Reg (Stmt, R_Sib); 1366 else 1367 if Reg in Regs_R64 then 1368 Reg1 := Reg; 1369 else 1370 Reg1 := R_Any64; 1371 end if; 1372 Set_Expr_Reg (Stmt, Alloc_Reg (Reg1, Stmt, Pnum)); 1373 Link_Stmt (Stmt); 1374 end if; 1375 else 1376 case Reg is 1377 when R_Sib 1378 | R_Irm 1379 | R_Ir => 1380 Set_Expr_Reg (Stmt, R_Imm); 1381 when R_Any32 1382 | Regs_R32 => 1383 Set_Expr_Reg (Stmt, Alloc_Reg (Reg, Stmt, Pnum)); 1384 Link_Stmt (Stmt); 1385 when others => 1386 Error_Gen_Insn (Stmt, Reg); 1387 end case; 1388 end if; 1389 return Stmt; 1390 when OE_Indir => 1391 Left := Get_Expr_Operand (Stmt); 1392 case Reg is 1393 when R_Irm 1394 | R_Rm => 1395 Left := Gen_Insn (Left, R_Sib, Pnum); 1396 Set_Expr_Reg (Stmt, R_Mem); 1397 Set_Expr_Operand (Stmt, Left); 1398 when R_Ir 1399 | R_Sib 1400 | R_I_Off => 1401 Num := Get_Insn_Num; 1402 Left := Gen_Insn (Left, R_Sib, Num); 1403 Reg1 := Get_Reg_Any (Stmt); 1404 if Reg1 = R_AnyPair then 1405 pragma Assert (not Flags.M64); 1406 Reg1 := Alloc_Reg (Reg1, Stmt, Pnum); 1407 Free_Insn_Regs (Left); 1408 else 1409 Free_Insn_Regs (Left); 1410 Reg1 := Alloc_Reg (Reg1, Stmt, Pnum); 1411 end if; 1412 Set_Expr_Reg (Stmt, Reg1); 1413 Set_Expr_Operand (Stmt, Left); 1414 Link_Stmt (Stmt); 1415 when Regs_R64 1416 | R_Any64 1417 | R_Any32 1418 | R_Any8 1419 | R_Any_Xmm 1420 | Regs_Fp 1421 | Regs_Xmm => 1422 Num := Get_Insn_Num; 1423 Left := Gen_Insn (Left, R_Sib, Num); 1424 Free_Insn_Regs (Left); 1425 Set_Expr_Reg (Stmt, Alloc_Reg (Reg, Stmt, Pnum)); 1426 Set_Expr_Operand (Stmt, Left); 1427 Link_Stmt (Stmt); 1428 when Regs_Pair 1429 | R_AnyPair => 1430 pragma Assert (not Flags.M64); 1431 -- Avoid overwritting: 1432 -- Eg: axdx = indir (ax) 1433 -- axdx = indir (ax+dx) 1434 Num := Get_Insn_Num; 1435 Left := Gen_Insn (Left, R_Sib, Num); 1436 Set_Expr_Reg (Stmt, Alloc_Reg (Reg, Stmt, Pnum)); 1437 Left := Reload (Left, R_Sib, Num); 1438 Free_Insn_Regs (Left); 1439 Set_Expr_Operand (Stmt, Left); 1440 Link_Stmt (Stmt); 1441 when R_Any_Cc => 1442 Num := Get_Insn_Num; 1443 Left := Gen_Insn (Left, R_Sib, Num); 1444 -- Generate a cmp $1, XX 1445 Set_Expr_Reg (Stmt, R_Eq); 1446 Set_Expr_Operand (Stmt, Left); 1447 Free_Insn_Regs (Left); 1448 Link_Stmt (Stmt); 1449 Alloc_Cc (Stmt, Pnum); 1450 when others => 1451 Error_Gen_Insn (Stmt, Reg); 1452 end case; 1453 return Stmt; 1454 when OE_Conv_Ptr => 1455 -- Delete nops. 1456 return Gen_Insn (Get_Expr_Operand (Stmt), Reg, Pnum); 1457 1458 when OE_Const => 1459 -- 2.2.1.3 Displacement 1460 -- They remain 8 bits or 32 bits and are sign-extended to 64 bits. 1461 -- 1462 -- 2.2.1.5 Immediates 1463 -- [..] the processor sign-extends all immediates to 64 bits prior 1464 -- their use. 1465 case Get_Expr_Mode (Stmt) is 1466 when Mode_U8 .. Mode_U32 1467 | Mode_I8 .. Mode_I32 1468 | Mode_P32 1469 | Mode_B2 => 1470 case Reg is 1471 when R_Imm 1472 | Regs_Imm32 => 1473 Set_Expr_Reg (Stmt, R_Imm); 1474 when Regs_R64 1475 | R_Any32 1476 | R_Any8 => 1477 Set_Expr_Reg (Stmt, Alloc_Reg (Reg, Stmt, Pnum)); 1478 Link_Stmt (Stmt); 1479 when R_Rm => 1480 Set_Expr_Reg 1481 (Stmt, Alloc_Reg (Get_Reg_Any (Stmt), Stmt, Pnum)); 1482 Link_Stmt (Stmt); 1483 when R_Any_Cc => 1484 Num := Get_Insn_Num; 1485 Set_Expr_Reg (Stmt, Alloc_Reg (R_Any8, Stmt, Num)); 1486 Link_Stmt (Stmt); 1487 Free_Insn_Regs (Stmt); 1488 Right := Insert_Move (Stmt, R_Ne); 1489 Alloc_Cc (Right, Pnum); 1490 return Right; 1491 when others => 1492 Error_Gen_Insn (Stmt, Reg); 1493 end case; 1494 when Mode_F32 1495 | Mode_F64 => 1496 Num := Get_Insn_Num; 1497 case Reg is 1498 when R_Ir 1499 | R_Irm 1500 | R_Rm => 1501 if Abi.Flag_Sse2 then 1502 Reg1 := R_Any_Xmm; 1503 else 1504 Reg1 := R_St0; 1505 end if; 1506 when R_St0 1507 | R_Any_Xmm 1508 | Regs_Xmm => 1509 Reg1 := Reg; 1510 when others => 1511 raise Program_Error; 1512 end case; 1513 Set_Expr_Reg (Stmt, Alloc_Reg (Reg1, Stmt, Num)); 1514 Link_Stmt (Stmt); 1515 when Mode_U64 1516 | Mode_I64 1517 | Mode_P64 => 1518 if Flags.M64 then 1519 if Is_Expr_S32 (Stmt) then 1520 -- Fit in a disp, can use SIB. 1521 case Reg is 1522 when R_Irm 1523 | R_Ir => 1524 Reg1 := R_Imm; 1525 when R_Mem => 1526 Reg1 := R_Mem; 1527 when Regs_R64 => 1528 Alloc_Gp (Reg, Stmt, Pnum); 1529 Reg1 := Reg; 1530 when R_Any64 1531 | R_Rm => 1532 Reg1 := Alloc_Reg (R_Any64, Stmt, Pnum); 1533 when others => 1534 raise Program_Error; 1535 end case; 1536 Set_Expr_Reg (Stmt, Reg1); 1537 if Reg1 in Regs_R64 then 1538 Link_Stmt (Stmt); 1539 end if; 1540 else 1541 -- Need a register to load the constants. 1542 if Reg in Regs_R64 then 1543 Reg1 := Reg; 1544 else 1545 Reg1 := R_Any64; 1546 end if; 1547 Set_Expr_Reg (Stmt, Alloc_Reg (Reg1, Stmt, Pnum)); 1548 Link_Stmt (Stmt); 1549 end if; 1550 else 1551 case Reg is 1552 when R_Irm 1553 | R_Ir 1554 | R_Rm => 1555 Set_Expr_Reg (Stmt, R_Imm); 1556 when R_Mem => 1557 Set_Expr_Reg (Stmt, R_Mem); 1558 when Regs_Pair 1559 | R_AnyPair => 1560 Set_Expr_Reg (Stmt, Alloc_Reg (Reg, Stmt, Pnum)); 1561 Link_Stmt (Stmt); 1562 when others => 1563 raise Program_Error; 1564 end case; 1565 end if; 1566 when others => 1567 raise Program_Error; 1568 end case; 1569 return Stmt; 1570 1571 when OE_Alloca => 1572 -- Roughly speaking, emited code is: (MASK is a constant). 1573 -- VAL := (VAL + MASK) & ~MASK 1574 -- SP := SP - VAL 1575 -- res <- SP 1576 Left := Get_Expr_Operand (Stmt); 1577 case Reg is 1578 when R_Ir 1579 | R_Irm 1580 | R_Any32 => 1581 Num := Get_Insn_Num; 1582 if X86.Flags.Flag_Alloca_Call then 1583 -- The alloca function returns its result in ax. 1584 Reg_L := R_Ax; 1585 else 1586 Reg_L := R_Any32; 1587 end if; 1588 Left := Gen_Insn (Left, Reg_L, Num); 1589 Set_Expr_Operand (Stmt, Left); 1590 Link_Stmt (Left); 1591 Free_Insn_Regs (Left); 1592 Set_Expr_Reg (Stmt, Alloc_Reg (Reg_L, Stmt, Pnum)); 1593 Link_Stmt (Stmt); 1594 when others => 1595 Error_Gen_Insn (Stmt, Reg); 1596 end case; 1597 return Stmt; 1598 1599 when OE_Kind_Cmp => 1600 -- Return LEFT cmp RIGHT, ie compute RIGHT - LEFT 1601 Num := Get_Insn_Num; 1602 Left := Get_Expr_Left (Stmt); 1603 Reg_L := Get_Reg_Any (Left); 1604 Left := Gen_Insn (Left, Reg_L, Num); 1605 1606 Right := Get_Expr_Right (Stmt); 1607 case Get_Expr_Mode (Right) is 1608 when Mode_F32 1609 | Mode_F64 => 1610 if Abi.Flag_Sse2 then 1611 Reg1 := R_Rm; 1612 else 1613 Reg1 := R_St0; 1614 end if; 1615 when others => 1616 Reg1 := R_Irm; 1617 end case; 1618 Right := Gen_Insn (Right, Reg1, Num); 1619 1620 -- FIXME: what about if right was spilled out of FP regs ? 1621 -- (it is reloaded in reverse). 1622 Left := Reload (Left, Reg_L, Num); 1623 1624 Set_Expr_Right (Stmt, Right); 1625 Set_Expr_Left (Stmt, Left); 1626 1627 Link_Stmt (Stmt); 1628 1629 Reg_Res := Ekind_To_Cc (Stmt, Get_Expr_Mode (Left)); 1630 case Get_Expr_Mode (Left) is 1631 when Mode_F32 1632 | Mode_F64 => 1633 if not Abi.Flag_Sse2 then 1634 -- Reverse only for FPU. 1635 Reg_Res := Reverse_Cc (Reg_Res); 1636 end if; 1637 when Mode_I64 => 1638 -- I64 is a little bit special on x86-32. 1639 if not Flags.M64 then 1640 Reg_Res := Get_Pair_High (Get_Expr_Reg (Left)); 1641 if Reg_Res not in Regs_R8 then 1642 Reg_Res := R_Nil; 1643 for I in Regs_R8 loop 1644 if Regs (I).Num = O_Free then 1645 Reg_Res := I; 1646 exit; 1647 end if; 1648 end loop; 1649 if Reg_Res = R_Nil then 1650 -- FIXME: to be handled. 1651 -- Can this happen ? 1652 raise Program_Error; 1653 end if; 1654 end if; 1655 1656 Free_Insn_Regs (Left); 1657 Free_Insn_Regs (Right); 1658 1659 Set_Expr_Reg (Stmt, Reg_Res); 1660 case Reg is 1661 when R_Any_Cc => 1662 Right := Insert_Move (Stmt, R_Ne); 1663 Alloc_Cc (Right, Pnum); 1664 return Right; 1665 when R_Any8 1666 | Regs_R8 1667 | R_Irm 1668 | R_Ir 1669 | R_Rm => 1670 Reg_Res := Alloc_Reg (Reg_Res, Stmt, Pnum); 1671 return Stmt; 1672 when others => 1673 Error_Gen_Insn (Stmt, Reg); 1674 end case; 1675 end if; 1676 when others => 1677 null; 1678 end case; 1679 Set_Expr_Reg (Stmt, Reg_Res); 1680 1681 Free_Insn_Regs (Left); 1682 Free_Insn_Regs (Right); 1683 1684 case Reg is 1685 when R_Any_Cc => 1686 Alloc_Cc (Stmt, Pnum); 1687 return Stmt; 1688 when R_Any8 1689 | Regs_R8 => 1690 Res := Insert_Move (Stmt, R_Any8); 1691 Reg_Res := Alloc_Reg (Reg, Res, Pnum); 1692 Set_Expr_Reg (Res, Reg_Res); 1693 return Res; 1694 when R_Irm 1695 | R_Ir 1696 | R_Rm => 1697 Res := Insert_Move (Stmt, R_Any32); 1698 Reg_Res := Alloc_Reg (R_Any8, Res, Pnum); 1699 Set_Expr_Reg (Res, Reg_Res); 1700 return Res; 1701 when others => 1702 Error_Gen_Insn (Stmt, Reg); 1703 end case; 1704 when OE_Add => 1705 declare 1706 R_L : O_Reg; 1707 R_R : O_Reg; 1708 begin 1709 Left := Gen_Insn (Get_Expr_Left (Stmt), R_Sib, Pnum); 1710 Right := Gen_Insn (Get_Expr_Right (Stmt), R_Sib, Pnum); 1711 Left := Reload (Left, R_Sib, Pnum); 1712 Set_Expr_Right (Stmt, Right); 1713 Set_Expr_Left (Stmt, Left); 1714 R_L := Get_Expr_Reg (Left); 1715 R_R := Get_Expr_Reg (Right); 1716 -- Results can be: Reg, R_B_Off, R_Sib, R_Imm, R_B_I 1717 case R_L is 1718 when R_Any32 1719 | R_Any64 1720 | Regs_R64 => 1721 case R_R is 1722 when R_Imm => 1723 Set_Expr_Reg (Stmt, R_B_Off); 1724 when R_B_Off 1725 | R_I 1726 | R_I_Off => 1727 Set_Expr_Reg (Stmt, R_Sib); 1728 when R_Any32 1729 | R_Any64 1730 | Regs_R64 => 1731 Set_Expr_Reg (Stmt, R_B_I); 1732 when others => 1733 Error_Gen_Insn (Stmt, R_R); 1734 end case; 1735 when R_Imm => 1736 case R_R is 1737 when R_Imm => 1738 Set_Expr_Reg (Stmt, R_Imm); 1739 when R_Any32 1740 | R_Any64 1741 | Regs_R64 1742 | R_B_Off => 1743 Set_Expr_Reg (Stmt, R_B_Off); 1744 when R_I 1745 | R_I_Off => 1746 Set_Expr_Reg (Stmt, R_I_Off); 1747 when others => 1748 Error_Gen_Insn (Stmt, R_R); 1749 end case; 1750 when R_B_Off => 1751 case R_R is 1752 when R_Imm => 1753 Set_Expr_Reg (Stmt, R_B_Off); 1754 when R_Any32 1755 | R_Any64 1756 | Regs_R64 1757 | R_I => 1758 Set_Expr_Reg (Stmt, R_Sib); 1759 when others => 1760 Error_Gen_Insn (Stmt, R_R); 1761 end case; 1762 when R_I_Off => 1763 case R_R is 1764 when R_Imm => 1765 Set_Expr_Reg (Stmt, R_I_Off); 1766 when R_Any32 1767 | R_Any64 1768 | Regs_R64 => 1769 Set_Expr_Reg (Stmt, R_Sib); 1770 when others => 1771 Error_Gen_Insn (Stmt, R_R); 1772 end case; 1773 when R_I => 1774 case R_R is 1775 when R_Imm 1776 | Regs_R64 1777 | R_B_Off => 1778 Set_Expr_Reg (Stmt, R_Sib); 1779 when others => 1780 Error_Gen_Insn (Stmt, R_R); 1781 end case; 1782 when R_Sib 1783 | R_B_I => 1784 if R_R = R_Imm then 1785 Set_Expr_Reg (Stmt, R_Sib); 1786 else 1787 Num := Get_Insn_Num; 1788 Free_Insn_Regs (Left); 1789 Set_Expr_Reg (Left, Alloc_Reg (R_Any32, Left, Num)); 1790 Link_Stmt (Left); 1791 case R_R is 1792 when R_Any32 1793 | R_Any64 1794 | Regs_R64 1795 | R_I => 1796 Set_Expr_Reg (Stmt, R_B_I); 1797 when others => 1798 Error_Gen_Insn (Stmt, R_R); 1799 end case; 1800 end if; 1801 when others => 1802 Error_Gen_Insn (Stmt, R_L); 1803 end case; 1804 1805 case Reg is 1806 when R_Sib => 1807 null; 1808 when R_Ir 1809 | R_Irm 1810 | R_Any32 1811 | R_Any64 1812 | Regs_R64 => 1813 if Get_Expr_Reg (Stmt) /= R_Imm then 1814 Free_Insn_Regs (Left); 1815 Free_Insn_Regs (Right); 1816 Set_Expr_Reg (Stmt, Alloc_Reg (R_Any32, Stmt, Pnum)); 1817 Link_Stmt (Stmt); 1818 end if; 1819 when others => 1820 Error_Gen_Insn (Stmt, Reg); 1821 end case; 1822 end; 1823 return Stmt; 1824 when OE_Mul => 1825 Num := Get_Insn_Num; 1826 Left := Gen_Insn (Get_Expr_Left (Stmt), R_Ax, Num); 1827 Set_Expr_Left (Stmt, Left); 1828 1829 Right := Gen_Insn (Get_Expr_Right (Stmt), R_Any32, Num); 1830 -- Only used to compute memory offset 1831 pragma Assert (Get_Expr_Kind (Right) = OE_Const); 1832 Set_Expr_Right (Stmt, Right); 1833 1834 Free_Insn_Regs (Left); 1835 Free_Insn_Regs (Right); 1836 Clobber_Gp (R_Dx); 1837 Set_Expr_Reg (Stmt, Alloc_Reg (R_Ax, Stmt, Pnum)); 1838 case Reg is 1839 when R_Sib 1840 | R_B_Off => 1841 null; 1842 when others => 1843 Error_Gen_Insn (Stmt, Reg); 1844 end case; 1845 Link_Stmt (Stmt); 1846 return Stmt; 1847 when OE_Shl => 1848 Num := Get_Insn_Num; 1849 Right := Get_Expr_Right (Stmt); 1850 if Get_Expr_Kind (Right) /= OE_Const then 1851 Right := Gen_Insn (Right, R_Cx, Num); 1852 else 1853 Right := Gen_Insn (Right, R_Imm, Num); 1854 end if; 1855 Left := Get_Expr_Left (Stmt); 1856 Reg1 := Get_Reg_Any (Stmt); 1857 Left := Gen_Insn (Left, Reg1, Pnum); 1858 if Get_Expr_Kind (Right) /= OE_Const then 1859 Right := Reload (Right, R_Cx, Num); 1860 end if; 1861 Left := Reload (Left, Reg1, Pnum); 1862 Set_Expr_Left (Stmt, Left); 1863 Set_Expr_Right (Stmt, Right); 1864 if Reg = R_Sib 1865 and then Get_Expr_Kind (Right) = OE_Const 1866 and then Get_Expr_Low (Right) in 0 .. 3 1867 then 1868 -- Becomes the index of the SIB. 1869 Set_Expr_Reg (Stmt, R_I); 1870 else 1871 Reg_Res := Get_Expr_Reg (Left); 1872 Set_Expr_Reg (Stmt, Reg_Res); 1873 Renum_Reg (Reg_Res, Stmt, Pnum); 1874 Link_Stmt (Stmt); 1875 Free_Insn_Regs (Right); 1876 end if; 1877 return Stmt; 1878 1879 when OE_Add_Ov 1880 | OE_Sub_Ov 1881 | OE_And 1882 | OE_Xor 1883 | OE_Or => 1884 -- Accepted is: R with IMM or R/M 1885 Num := Get_Insn_Num; 1886 Right := Get_Expr_Right (Stmt); 1887 Left := Get_Expr_Left (Stmt); 1888 case Reg is 1889 when R_Irm 1890 | R_Rm 1891 | R_Ir 1892 | R_Sib => 1893 Right := Gen_Insn (Right, R_Irm, Num); 1894 Reg1 := Get_Reg_Any (Stmt); 1895 Left := Gen_Insn (Left, Reg1, Num); 1896 Right := Reload (Right, R_Irm, Num); 1897 Left := Reload (Left, Reg1, Num); 1898 Reg_Res := Get_Expr_Reg (Left); 1899 when R_Any_Cc => 1900 Right := Gen_Insn (Right, R_Irm, Num); 1901 Left := Gen_Insn (Left, R_Any8, Num); 1902 Left := Reload (Left, R_Irm, Num); 1903 Right := Reload (Right, R_Any8, Num); 1904 Reg_Res := R_Ne; 1905 Alloc_Cc (Stmt, Num); 1906 Free_Insn_Regs (Left); 1907 when R_Any32 1908 | R_Any64 1909 | Regs_R64 1910 | R_Any8 1911 | R_AnyPair 1912 | R_Any_Xmm 1913 | Regs_Pair 1914 | Regs_Fp 1915 | Regs_Xmm => 1916 Left := Gen_Insn (Left, Reg, Num); 1917 Right := Gen_Insn (Right, R_Irm, Num); 1918 Left := Reload (Left, Reg, Num); 1919 Right := Reload (Right, R_Irm, Num); 1920 Reg_Res := Get_Expr_Reg (Left); 1921 when others => 1922 Error_Gen_Insn (Stmt, Reg); 1923 end case; 1924 Set_Expr_Right (Stmt, Right); 1925 Set_Expr_Left (Stmt, Left); 1926 Set_Expr_Reg (Stmt, Reg_Res); 1927 Renum_Reg (Reg_Res, Stmt, Pnum); 1928 Link_Stmt (Stmt); 1929 Free_Insn_Regs (Right); 1930 return Stmt; 1931 1932 when OE_Mod 1933 | OE_Rem 1934 | OE_Mul_Ov 1935 | OE_Div_Ov => 1936 declare 1937 Mode : constant Mode_Type := Get_Expr_Mode (Stmt); 1938 begin 1939 Num := Get_Insn_Num; 1940 Left := Get_Expr_Left (Stmt); 1941 Right := Get_Expr_Right (Stmt); 1942 1943 if not Flags.M64 1944 and (Mode = Mode_I64 or Mode = Mode_U64) 1945 then 1946 -- Call libgcc helper on x86-32. 1947 -- FIXME: align stack 1948 Insert_Arg (Gen_Insn (Right, R_Irm, Num)); 1949 Insert_Arg (Gen_Insn (Left, R_Irm, Num)); 1950 return Insert_Intrinsic (Stmt, R_Edx_Eax, Pnum); 1951 end if; 1952 1953 case Mode is 1954 when Mode_I32 1955 | Mode_U32 1956 | Mode_I64 1957 | Mode_U64 1958 | Mode_I16 1959 | Mode_U16 => 1960 Left := Gen_Insn (Left, R_Ax, Num); 1961 Right := Gen_Insn (Right, R_Rm, Num); 1962 Left := Reload (Left, R_Ax, Num); 1963 case Kind is 1964 when OE_Div_Ov 1965 | OE_Rem 1966 | OE_Mod => 1967 -- Be sure EDX is free. 1968 Reg_Res := Alloc_Reg (R_Dx, Stmt, Pnum); 1969 when others => 1970 Reg_Res := R_Nil; 1971 end case; 1972 Right := Reload (Right, R_Rm, Num); 1973 Set_Expr_Right (Stmt, Right); 1974 Set_Expr_Left (Stmt, Left); 1975 Free_Insn_Regs (Left); 1976 Free_Insn_Regs (Right); 1977 if Reg_Res /= R_Nil then 1978 Free_Gp (Reg_Res); 1979 end if; 1980 if Kind = OE_Div_Ov or Kind = OE_Mul_Ov then 1981 Reg_Res := R_Ax; 1982 Clobber_Gp (R_Dx); 1983 else 1984 Reg_Res := R_Dx; 1985 Clobber_Gp (R_Ax); 1986 end if; 1987 Set_Expr_Reg (Stmt, Alloc_Reg (Reg_Res, Stmt, Pnum)); 1988 Link_Stmt (Stmt); 1989 return Reload (Stmt, Reg, Pnum); 1990 when Mode_F32 1991 | Mode_F64 => 1992 if Abi.Flag_Sse2 then 1993 if Reg in Regs_Xmm then 1994 Reg_Res := Reg; 1995 else 1996 Reg_Res := R_Any_Xmm; 1997 end if; 1998 else 1999 Reg_Res := R_St0; 2000 end if; 2001 Left := Gen_Insn (Left, Reg_Res, Num); 2002 Right := Gen_Insn (Right, R_Irm, Num); 2003 Left := Reload (Left, Reg_Res, Num); 2004 Right := Reload (Right, R_Irm, Num); 2005 Reg_Res := Get_Expr_Reg (Left); 2006 Set_Expr_Right (Stmt, Right); 2007 Set_Expr_Left (Stmt, Left); 2008 Set_Expr_Reg (Stmt, Reg_Res); 2009 Renum_Reg (Reg_Res, Stmt, Pnum); 2010 Free_Insn_Regs (Right); 2011 Link_Stmt (Stmt); 2012 return Stmt; 2013 when others => 2014 Error_Gen_Insn (Stmt, Mode); 2015 end case; 2016 end; 2017 2018 when OE_Not 2019 | OE_Abs_Ov 2020 | OE_Neg_Ov => 2021 Left := Get_Expr_Operand (Stmt); 2022 case Reg is 2023 when R_Any32 2024 | R_Any64 2025 | R_AnyPair 2026 | Regs_Pair 2027 | R_Any8 2028 | R_St0 2029 | Regs_R64 2030 | Regs_Xmm 2031 | R_Any_Xmm => 2032 Reg_Res := Reg; 2033 when R_Any_Cc => 2034 -- Only oe_not is allowed for booleans. 2035 pragma Assert (Kind = OE_Not); 2036 Left := Gen_Insn (Left, R_Any_Cc, Pnum); 2037 Set_Expr_Operand (Stmt, Left); 2038 Reg_Res := Inverse_Cc (Get_Expr_Reg (Left)); 2039 Free_Cc; 2040 Set_Expr_Reg (Stmt, Reg_Res); 2041 Alloc_Cc (Stmt, Pnum); 2042 return Stmt; 2043 when R_Irm 2044 | R_Rm 2045 | R_Ir => 2046 Reg_Res := Get_Reg_Any (Left); 2047 when others => 2048 Error_Gen_Insn (Stmt, Reg); 2049 end case; 2050 Left := Gen_Insn (Left, Reg_Res, Pnum); 2051 Set_Expr_Operand (Stmt, Left); 2052 Reg_Res := Get_Expr_Reg (Left); 2053 Free_Insn_Regs (Left); 2054 Set_Expr_Reg (Stmt, Alloc_Reg (Reg_Res, Stmt, Pnum)); 2055 Link_Stmt (Stmt); 2056 return Stmt; 2057 when OE_Conv_Ov 2058 | OE_Conv => 2059 Left := Get_Expr_Operand (Stmt); 2060 declare 2061 -- Operand mode 2062 O_Mode : constant Mode_Type := Get_Expr_Mode (Left); 2063 2064 -- Result mode 2065 R_Mode : constant Mode_Type := Get_Expr_Mode (Stmt); 2066 2067 Reg_Op : O_Reg; 2068 begin 2069 -- Simple case: no conversion. 2070 -- FIXME: should be handled by EXPR and convert to NOP. 2071 if Get_Expr_Mode (Left) = Get_Expr_Mode (Stmt) then 2072 -- A no-op. 2073 return Gen_Insn (Left, Reg, Pnum); 2074 end if; 2075 2076 -- By default, can work on reg or memory. 2077 Reg_Op := R_Rm; 2078 2079 -- Case on target. 2080 case R_Mode is 2081 when Mode_B2 => 2082 -- To B2 2083 case O_Mode is 2084 when Mode_U32 2085 | Mode_I32 => 2086 -- Detect for bound. 2087 null; 2088 when Mode_I64 => 2089 if not Flags.M64 then 2090 -- Work on registers. 2091 Reg_Op := R_AnyPair; 2092 end if; 2093 when others => 2094 Error_Gen_Insn (Stmt, O_Mode); 2095 end case; 2096 when Mode_U8 => 2097 -- To U8 2098 case O_Mode is 2099 when Mode_U16 2100 | Mode_U32 2101 | Mode_I32 => 2102 -- Detect for bound. 2103 null; 2104 when Mode_I64 => 2105 if not Flags.M64 then 2106 -- Work on registers. 2107 Reg_Op := R_AnyPair; 2108 end if; 2109 when others => 2110 Error_Gen_Insn (Stmt, O_Mode); 2111 end case; 2112 when Mode_U32 => 2113 -- To U32 2114 case O_Mode is 2115 when Mode_I32 => 2116 -- Detect for bound. 2117 null; 2118 when Mode_B2 2119 | Mode_U8 2120 | Mode_U16 => 2121 -- Zero extend. 2122 null; 2123 when others => 2124 Error_Gen_Insn (Stmt, O_Mode); 2125 end case; 2126 when Mode_I32 => 2127 -- To I32 2128 case O_Mode is 2129 when Mode_U8 2130 | Mode_I8 2131 | Mode_B2 2132 | Mode_U16 2133 | Mode_U32 => 2134 -- Zero extend 2135 -- Detect for bound (U32). 2136 null; 2137 when Mode_I64 => 2138 -- Detect for bound (U32) 2139 Num := Get_Insn_Num; 2140 if Flags.M64 then 2141 -- Use movsxd to compare. 2142 Left := Gen_Insn (Left, R_Any64, Num); 2143 Set_Expr_Reg 2144 (Stmt, Alloc_Reg (R_Any32, Stmt, Num)); 2145 Free_Insn_Regs (Left); 2146 else 2147 -- Use cdq to compare, keep ax. 2148 Left := Gen_Insn (Left, R_Edx_Eax, Num); 2149 Free_Insn_Regs (Left); 2150 case Reg is 2151 when R_Ax 2152 | R_Any32 2153 | R_Rm 2154 | R_Irm 2155 | R_Ir => 2156 Set_Expr_Reg 2157 (Stmt, Alloc_Reg (R_Ax, Stmt, Num)); 2158 when others => 2159 raise Program_Error; 2160 end case; 2161 -- Need an extra register to compare. 2162 Insert_Reg (Mode_U32); 2163 end if; 2164 Set_Expr_Operand (Stmt, Left); 2165 Link_Stmt (Stmt); 2166 return Stmt; 2167 when Mode_F64 2168 | Mode_F32 => 2169 return Gen_Conv_From_Fp_Insn (Stmt, Reg, Pnum); 2170 when others => 2171 Error_Gen_Insn (Stmt, O_Mode); 2172 end case; 2173 when Mode_I64 => 2174 -- To I64 2175 case O_Mode is 2176 when Mode_I32 2177 | Mode_U32 2178 | Mode_U8 2179 | Mode_B2 => 2180 -- Zero or Sign extend. 2181 Num := Get_Insn_Num; 2182 if Flags.M64 then 2183 -- Use movsxd / movl 2184 Left := 2185 Gen_Insn (Left, Get_Reg_Any (O_Mode), Num); 2186 case Reg is 2187 when Regs_R64 => 2188 Reg1 := Reg; 2189 when R_Any64 2190 | R_Rm 2191 | R_Irm 2192 | R_Ir => 2193 Reg1 := R_Any64; 2194 when others => 2195 raise Program_Error; 2196 end case; 2197 else 2198 Left := Gen_Insn (Left, R_Ax, Num); 2199 case Reg is 2200 when R_Edx_Eax 2201 | R_AnyPair 2202 | R_Rm 2203 | R_Irm 2204 | R_Ir => 2205 Reg1 := R_Edx_Eax; 2206 when others => 2207 raise Program_Error; 2208 end case; 2209 end if; 2210 Set_Expr_Operand (Stmt, Left); 2211 Free_Insn_Regs (Left); 2212 Set_Expr_Reg (Stmt, Alloc_Reg (Reg1, Stmt, Pnum)); 2213 Link_Stmt (Stmt); 2214 return Stmt; 2215 when Mode_F64 2216 | Mode_F32 => 2217 return Gen_Conv_From_Fp_Insn (Stmt, Reg, Pnum); 2218 when others => 2219 Error_Gen_Insn (Stmt, O_Mode); 2220 end case; 2221 when Mode_F64 => 2222 -- To F64 2223 case O_Mode is 2224 when Mode_I32 2225 | Mode_I64 => 2226 null; 2227 when others => 2228 Error_Gen_Insn (Stmt, O_Mode); 2229 end case; 2230 when others => 2231 Error_Gen_Insn (Stmt, O_Mode); 2232 end case; 2233 Left := Gen_Insn (Left, Reg_Op, Pnum); 2234 Set_Expr_Operand (Stmt, Left); 2235 case Reg is 2236 when R_Irm 2237 | R_Rm 2238 | R_Ir 2239 | R_Sib 2240 | R_Any64 2241 | R_Any32 2242 | R_AnyPair 2243 | R_Any8 2244 | R_Any_Xmm => 2245 Reg_Res := Get_Reg_Any (Stmt); 2246 when Regs_R64 2247 | Regs_Pair 2248 | Regs_Fp 2249 | Regs_Xmm => 2250 Reg_Res := Reg; 2251 when others => 2252 Error_Gen_Insn (Stmt, Reg); 2253 end case; 2254 Free_Insn_Regs (Left); 2255 Set_Expr_Reg (Stmt, Alloc_Reg (Reg_Res, Stmt, Pnum)); 2256 Link_Stmt (Stmt); 2257 return Stmt; 2258 end; 2259 when OE_Arg => 2260 -- Handled by Gen_Call. 2261 raise Program_Error; 2262 when OE_Call => 2263 return Gen_Call (Stmt, Reg, Pnum); 2264 when OE_Case_Expr => 2265 Left := Get_Expr_Operand (Stmt); 2266 Set_Expr_Reg (Stmt, Alloc_Reg (Get_Expr_Reg (Left), Stmt, Pnum)); 2267 return Stmt; 2268 when OE_Get_Stack => 2269 Set_Expr_Reg (Stmt, R_Sp); 2270 return Stmt; 2271 when OE_Get_Frame => 2272 Set_Expr_Reg (Stmt, R_Bp); 2273 return Stmt; 2274 when others => 2275 Ada.Text_IO.Put_Line 2276 ("gen_insn: unhandled enode " & OE_Kind'Image (Kind)); 2277 raise Program_Error; 2278 end case; 2279 end Gen_Insn; 2280 2281 procedure Assert_Free_Regs (Stmt : O_Enode) is 2282 begin 2283 for I in Regs_R64 loop 2284 if Regs (I).Num /= O_Free then 2285 Error_Reg ("gen_insn_stmt: reg is not free", Stmt, I); 2286 end if; 2287 end loop; 2288 if not Abi.Flag_Sse2 then 2289 for I in Fp_Stack_Type loop 2290 if Fp_Regs (I).Stmt /= O_Enode_Null then 2291 Error_Reg ("gen_insn_stmt: reg is not free", Stmt, R_St0); 2292 end if; 2293 end loop; 2294 end if; 2295 end Assert_Free_Regs; 2296 2297 procedure Gen_Insn_Stmt (Stmt : O_Enode) 2298 is 2299 Kind : constant OE_Kind := Get_Expr_Kind (Stmt); 2300 2301 Left : O_Enode; 2302 Right : O_Enode; 2303 P_Reg : O_Reg; 2304 Num : O_Inum; 2305 2306 Prev_Stack_Offset : Uns32; 2307 begin 2308 Insn_Num := O_Iroot; 2309 Num := Get_Insn_Num; 2310 Prev_Stack_Offset := Stack_Offset; 2311 2312 case Kind is 2313 when OE_Asgn => 2314 Right := Gen_Insn (Get_Expr_Operand (Stmt), R_Ir, Num); 2315 Left := Gen_Insn (Get_Assign_Target (Stmt), R_Sib, Num); 2316 Right := Reload (Right, R_Ir, Num); 2317 --Left := Reload (Left, R_Sib, Num); 2318 Set_Expr_Operand (Stmt, Right); 2319 Set_Assign_Target (Stmt, Left); 2320 Link_Stmt (Stmt); 2321 Free_Insn_Regs (Left); 2322 Free_Insn_Regs (Right); 2323 when OE_Set_Stack => 2324 Left := Gen_Insn (Get_Expr_Operand (Stmt), R_Rm, Num); 2325 Set_Expr_Operand (Stmt, Left); 2326 Set_Expr_Reg (Stmt, R_Sp); 2327 Link_Stmt (Stmt); 2328 when OE_Jump_F 2329 | OE_Jump_T => 2330 Left := Gen_Insn (Get_Expr_Operand (Stmt), R_Any_Cc, Num); 2331 Set_Expr_Operand (Stmt, Left); 2332 Link_Stmt (Stmt); 2333 Free_Cc; 2334 when OE_Beg => 2335 declare 2336 Block_Decl : O_Dnode; 2337 begin 2338 Cur_Block := Stmt; 2339 Block_Decl := Get_Block_Decls (Cur_Block); 2340 -- Save current frame size (to be restored at end of block). 2341 Set_Block_Max_Stack (Block_Decl, Stack_Offset); 2342 -- Allocate slots for local declarations. 2343 Expand_Decls (Block_Decl); 2344 end; 2345 Link_Stmt (Stmt); 2346 when OE_End => 2347 -- Restore current frame size (so deallocate the slots for the 2348 -- local declarations). 2349 Swap_Stack_Offset (Get_Block_Decls (Cur_Block)); 2350 Cur_Block := Get_Block_Parent (Cur_Block); 2351 Link_Stmt (Stmt); 2352 when OE_Jump 2353 | OE_Label => 2354 Link_Stmt (Stmt); 2355 when OE_Leave => 2356 Link_Stmt (Stmt); 2357 when OE_Call => 2358 Left := Gen_Call (Stmt, R_None, Num); 2359 -- Gen_Call already link the statement. Discard the result. 2360 when OE_Ret => 2361 Left := Get_Expr_Operand (Stmt); 2362 P_Reg := Get_Return_Register (Get_Expr_Mode (Stmt)); 2363 Left := Gen_Insn (Left, P_Reg, Num); 2364 Set_Expr_Operand (Stmt, Left); 2365 Link_Stmt (Stmt); 2366 Free_Insn_Regs (Left); 2367 when OE_Case => 2368 Left := Gen_Insn (Get_Expr_Operand (Stmt), 2369 Get_Reg_Any (Stmt), Num); 2370 Set_Expr_Operand (Stmt, Left); 2371 Set_Expr_Reg (Stmt, Get_Expr_Reg (Left)); 2372 Link_Stmt (Stmt); 2373 Free_Insn_Regs (Left); 2374 when OE_Line => 2375 Set_Expr_Reg (Stmt, R_None); 2376 Link_Stmt (Stmt); 2377 when OE_BB => 2378 -- Keep BB. 2379 Link_Stmt (Stmt); 2380 when others => 2381 Ada.Text_IO.Put_Line 2382 ("gen_insn_stmt: unhandled enode " & OE_Kind'Image (Kind)); 2383 raise Program_Error; 2384 end case; 2385 2386 -- Free any spill stack slots. 2387 case Kind is 2388 when OE_Beg 2389 | OE_End => 2390 -- Stack offset has been explicitely changed for local variables. 2391 null; 2392 when others => 2393 Stack_Offset := Prev_Stack_Offset; 2394 end case; 2395 2396 -- Check all registers are free. 2397 pragma Debug (Assert_Free_Regs (Stmt)); 2398 end Gen_Insn_Stmt; 2399 2400 procedure Gen_Subprg_Insns (Subprg : Subprogram_Data_Acc) 2401 is 2402 First : O_Enode; 2403 Stmt : O_Enode; 2404 N_Stmt : O_Enode; 2405 begin 2406 -- Handle --be-debug=i: disp subprogram declaration before the 2407 -- statements. 2408 if Debug.Flag_Debug_Insn then 2409 declare 2410 Inter : O_Dnode; 2411 begin 2412 Disp_Decl (1, Subprg.D_Decl); 2413 Inter := Get_Subprg_Interfaces (Subprg.D_Decl); 2414 while Inter /= O_Dnode_Null loop 2415 Disp_Decl (2, Inter); 2416 Inter := Get_Interface_Chain (Inter); 2417 end loop; 2418 end; 2419 end if; 2420 2421 Stack_Offset := 0; 2422 Need_Fp_Conv_Slot := False; 2423 2424 -- Save parameters on stack (just alloc). 2425 -- First the integers then the floats (to use push). 2426 if Flags.M64 then 2427 declare 2428 Inter : O_Dnode; 2429 R : O_Reg; 2430 begin 2431 for Pass in 1 .. 2 loop 2432 Inter := Get_Subprg_Interfaces (Subprg.D_Decl); 2433 while Inter /= O_Dnode_Null loop 2434 R := Get_Decl_Reg (Inter); 2435 if (Pass = 1 and then R in Regs_R64) 2436 or else (Pass = 2 and then R in Regs_Xmm) 2437 then 2438 Stack_Offset := Stack_Offset + 8; 2439 Set_Local_Offset (Inter, - Int32 (Stack_Offset)); 2440 end if; 2441 Inter := Get_Interface_Chain (Inter); 2442 end loop; 2443 end loop; 2444 end; 2445 end if; 2446 2447 Stack_Max := Stack_Offset; 2448 2449 -- Before the prologue, all registers are unused. 2450 for I in Regs_R64 loop 2451 Regs (I).Used := False; 2452 end loop; 2453 2454 First := Subprg.E_Entry; 2455 Expand_Decls (Subprg.D_Body + 1); 2456 Abi.Last_Link := First; 2457 2458 -- Generate instructions. 2459 -- Skip OE_Entry. 2460 Stmt := Get_Stmt_Link (First); 2461 loop 2462 N_Stmt := Get_Stmt_Link (Stmt); 2463 Gen_Insn_Stmt (Stmt); 2464 exit when Get_Expr_Kind (Stmt) = OE_Leave; 2465 Stmt := N_Stmt; 2466 end loop; 2467 2468 -- Allocate one stack slot for fp conversion for the whole subprogram. 2469 if Need_Fp_Conv_Slot then 2470 pragma Assert (Abi.Flag_Sse2 and not Flags.M64); 2471 Stack_Max := Do_Align (Stack_Max, 8); 2472 Stack_Max := Stack_Max + 8; 2473 Subprg.Target.Fp_Slot := Stack_Max; 2474 end if; 2475 2476 -- Keep stack depth for this subprogram. 2477 Subprg.Stack_Max := Stack_Max; 2478 2479 -- Sanity check: there must be no remaining pushed bytes. 2480 pragma Assert (Push_Offset = 0); 2481 end Gen_Subprg_Insns; 2482end Ortho_Code.X86.Insns; 2483