1-- Mcode back-end for ortho - Binary X86 instructions generator. 2-- Copyright (C) 2006 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>. 16with Ortho_Code.Abi; 17with Ortho_Code.Decls; 18with Ortho_Code.Types; 19with Ortho_Code.Consts; 20with Ortho_Code.Debug; 21with Ortho_Code.X86.Insns; 22with Ortho_Code.X86.Flags; 23with Ortho_Code.Flags; 24with Ortho_Code.Dwarf; 25with Ortho_Code.Binary; use Ortho_Code.Binary; 26with Ortho_Ident; 27with Ada.Text_IO; 28with Interfaces; use Interfaces; 29 30package body Ortho_Code.X86.Emits is 31 type Insn_Size is (Sz_8, Sz_16, Sz_32, Sz_32l, Sz_32h, Sz_64); 32 33 -- Sz_64 if M64 or Sz_32 34 Sz_Ptr : constant Insn_Size := Insn_Size'Val 35 (Boolean'Pos (Flags.M64) * Insn_Size'Pos (Sz_64) 36 + Boolean'Pos (not Flags.M64) * Insn_Size'Pos (Sz_32)); 37 38 -- For FP, size doesn't matter in modrm and SIB. But don't emit the REX.W 39 -- prefix, that's useless. 40 Sz_Fp : constant Insn_Size := Sz_32; 41 42 type Int_Mode_To_Size_Array is array (Mode_U8 .. Mode_I64) of Insn_Size; 43 Int_Mode_To_Size : constant Int_Mode_To_Size_Array := 44 (Mode_U8 | Mode_I8 => Sz_8, 45 Mode_U16 | Mode_I16 => Sz_16, 46 Mode_U32 | Mode_I32 => Sz_32, 47 Mode_U64 | Mode_I64 => Sz_64); 48 49 -- Well known sections. 50 Sect_Text : Binary_File.Section_Acc; 51 Sect_Rodata : Binary_File.Section_Acc; 52 Sect_Bss : Binary_File.Section_Acc; 53 54 -- For 64 bit to 32 bit conversion, we need an extra register. Just before 55 -- the conversion, there is an OE_Reg instruction containing the extra 56 -- register. Its value is saved here. 57 Reg_Helper : O_Reg; 58 59 Subprg_Pc : Pc_Type; 60 61 -- x86 opcodes. 62 Opc_Data16 : constant := 16#66#; 63-- Opc_Rex : constant := 16#40#; 64 Opc_Rex_W : constant := 16#48#; 65 Opc_Rex_R : constant := 16#44#; 66 Opc_Rex_X : constant := 16#42#; 67 Opc_Rex_B : constant := 16#41#; 68 Opc_Into : constant := 16#ce#; 69 Opc_Cdq : constant := 16#99#; 70 Opc_Int : constant := 16#cd#; 71 Opc_Addl_Reg_Rm : constant := 16#03#; 72 Opc_Xorl_Rm_Reg : constant := 16#31#; 73 Opc_Subl_Reg_Rm : constant := 16#2b#; -- Reg <- Reg - Rm 74 Opc_Cmpl_Rm_Reg : constant := 16#39#; 75 Opc_Leal_Reg_Rm : constant := 16#8d#; 76 Opc_Movb_Imm_Reg : constant := 16#b0#; 77 Opc_Movl_Imm_Reg : constant := 16#b8#; 78 Opc_Movsxd_Reg_Rm : constant := 16#63#; 79 Opc_Imul_Reg_Rm_Imm32 : constant := 16#69#; 80 Opc_Imul_Reg_Rm_Imm8 : constant := 16#6b#; 81 Opc_Mov_Rm_Imm : constant := 16#c6#; -- Eb,Ib or Ev,Iz (grp11, opc2=0) 82 Opc_Mov_Rm_Reg : constant := 16#88#; -- Store: Eb,Gb or Ev,Gv 83 Opc_Mov_Reg_Rm : constant := 16#8a#; -- Load: Gb,Eb or Gv,Ev 84 Opc_Movl_Reg_Rm : constant := 16#8b#; -- Load: Gv,Ev 85 -- Opc_Grp1_Rm_Imm : constant := 16#80#; 86 Opc_Grp1b_Rm_Imm8 : constant := 16#80#; 87 Opc_Grp1v_Rm_Imm32 : constant := 16#81#; 88 -- Opc_Grp1b_Rm_Imm8 : constant := 16#82#; -- Should not be used. 89 Opc_Grp1v_Rm_Imm8 : constant := 16#83#; 90 Opc2_Grp1_Add : constant := 2#000_000#; -- Second byte 91 Opc2_Grp1_Or : constant := 2#001_000#; -- Second byte 92 Opc2_Grp1_Adc : constant := 2#010_000#; -- Second byte 93 Opc2_Grp1_Sbb : constant := 2#011_000#; -- Second byte 94 Opc2_Grp1_And : constant := 2#100_000#; -- Second byte 95 Opc2_Grp1_Sub : constant := 2#101_000#; -- Second byte 96 Opc2_Grp1_Xor : constant := 2#110_000#; -- Second byte 97 Opc2_Grp1_Cmp : constant := 2#111_000#; -- Second byte 98 Opc_Grp3_Width : constant := 16#f6#; 99 Opc2_Grp3_Not : constant := 2#010_000#; 100 Opc2_Grp3_Neg : constant := 2#011_000#; 101 Opc2_Grp3_Mul : constant := 2#100_000#; 102 Opc2_Grp3_Imul : constant := 2#101_000#; 103 Opc2_Grp3_Div : constant := 2#110_000#; 104 Opc2_Grp3_Idiv : constant := 2#111_000#; 105 Opc_Test_Rm_Reg : constant := 16#84#; -- Eb,Gb or Ev,Gv 106 Opc_Push_Imm8 : constant := 16#6a#; 107 Opc_Push_Imm : constant := 16#68#; 108 Opc_Push_Reg : constant := 16#50#; -- opc[2:0] is reg. 109 Opc_Pop_Reg : constant := 16#58#; -- opc[2:0] is reg. 110 Opc_Grp5 : constant := 16#ff#; 111 Opc2_Grp5_Push_Rm : constant := 2#110_000#; 112 -- Opc_Grp1a : constant := 16#8f#; 113 -- Opc2_Grp1a_Pop_Rm : constant := 2#000_000#; 114 Opc_Jcc : constant := 16#70#; 115 Opc_0f : constant := 16#0f#; 116 Opc2_0f_Jcc : constant := 16#80#; 117 Opc2_0f_Setcc : constant := 16#90#; 118 Opc2_0f_Movzx : constant := 16#b6#; 119 Opc2_0f_Imul : constant := 16#af#; 120 Opc2_0f_Andp : constant := 16#54#; 121 Opc2_0f_Xorp : constant := 16#57#; 122 Opc_Call : constant := 16#e8#; 123 Opc_Jmp_Long : constant := 16#e9#; 124 Opc_Jmp_Short : constant := 16#eb#; 125 Opc_Ret : constant := 16#c3#; 126 Opc_Leave : constant := 16#c9#; 127 Opc_Movsd_Xmm_M64 : constant := 16#10#; -- Load xmm <- M64 128 Opc_Movsd_M64_Xmm : constant := 16#11#; -- Store M64 <- xmm 129 Opc_Cvtsi2sd_Xmm_Rm : constant := 16#2a#; -- Xmm <- cvt (rm) 130 Opc_Cvtsd2si_Reg_Xm : constant := 16#2d#; -- Reg <- cvt (xmm/m64) 131 132 procedure Error_Emit (Msg : String; Insn : O_Enode) 133 is 134 use Ada.Text_IO; 135 begin 136 Put ("error_emit: "); 137 Put (Msg); 138 Put (", insn="); 139 Put (O_Enode'Image (Insn)); 140 Put (" ("); 141 Put (OE_Kind'Image (Get_Expr_Kind (Insn))); 142 Put (")"); 143 New_Line; 144 raise Program_Error; 145 end Error_Emit; 146 147 procedure Gen_Rex (B : Byte) is 148 begin 149 if Flags.M64 then 150 Gen_8 (B); 151 end if; 152 end Gen_Rex; 153 154 procedure Gen_Rex_B (R : O_Reg; Sz : Insn_Size) 155 is 156 B : Byte; 157 begin 158 if Flags.M64 then 159 B := 0; 160 if R in Regs_R8_R15 or R in Regs_Xmm8_Xmm15 then 161 B := B or Opc_Rex_B; 162 end if; 163 if Sz = Sz_64 then 164 B := B or Opc_Rex_W; 165 end if; 166 if B /= 0 then 167 Gen_8 (B); 168 end if; 169 end if; 170 end Gen_Rex_B; 171 172 -- For many opcodes, the size of the operand is coded in bit 0, and the 173 -- prefix data16 can be used for 16-bit operation. 174 -- Deal with size. 175 procedure Gen_Insn_Sz (B : Byte; Sz : Insn_Size) is 176 begin 177 case Sz is 178 when Sz_8 => 179 Gen_8 (B); 180 when Sz_16 => 181 Gen_8 (Opc_Data16); 182 Gen_8 (B + 1); 183 when Sz_32 184 | Sz_32l 185 | Sz_32h 186 | Sz_64 => 187 Gen_8 (B + 1); 188 end case; 189 end Gen_Insn_Sz; 190 191 procedure Gen_Insn_Sz_S8 (B : Byte; Sz : Insn_Size) is 192 begin 193 case Sz is 194 when Sz_8 => 195 Gen_8 (B); 196 when Sz_16 => 197 Gen_8 (Opc_Data16); 198 Gen_8 (B + 3); 199 when Sz_32 200 | Sz_32l 201 | Sz_32h 202 | Sz_64 => 203 Gen_8 (B + 3); 204 end case; 205 end Gen_Insn_Sz_S8; 206 207 function Get_Const_Val (C : O_Enode; Sz : Insn_Size) return Uns32 is 208 begin 209 case Sz is 210 when Sz_8 211 | Sz_16 212 | Sz_32 213 | Sz_32l => 214 return Get_Expr_Low (C); 215 when Sz_32h => 216 return Get_Expr_High (C); 217 when Sz_64 => 218 return Get_Expr_Low (C); 219 end case; 220 end Get_Const_Val; 221 222 function Is_Imm8 (N : O_Enode; Sz : Insn_Size) return Boolean is 223 begin 224 if Get_Expr_Kind (N) /= OE_Const then 225 return False; 226 end if; 227 return Get_Const_Val (N, Sz) <= 127; 228 end Is_Imm8; 229 230 procedure Gen_Imm8 (N : O_Enode; Sz : Insn_Size) is 231 begin 232 Gen_8 (Byte (Get_Const_Val (N, Sz))); 233 end Gen_Imm8; 234 235-- procedure Gen_Imm32 (N : O_Enode; Sz : Insn_Size) 236-- is 237-- use Interfaces; 238-- begin 239-- case Get_Expr_Kind (N) is 240-- when OE_Const => 241-- Gen_32 (Unsigned_32 (Get_Const_Val (N, Sz))); 242-- when OE_Addrg => 243-- Gen_X86_32 (Get_Decl_Symbol (Get_Addr_Object (N)), 0); 244-- when others => 245-- raise Program_Error; 246-- end case; 247-- end Gen_Imm32; 248 249 -- Generate an immediat constant. 250 procedure Gen_Imm_Addr (N : O_Enode) 251 is 252 Sym : Symbol; 253 P : O_Enode; 254 L, R : O_Enode; 255 S, C : O_Enode; 256 Off : Int32; 257 begin 258 Off := 0; 259 P := N; 260 while Get_Expr_Kind (P) = OE_Add loop 261 L := Get_Expr_Left (P); 262 R := Get_Expr_Right (P); 263 264 -- Extract the const node. 265 if Get_Expr_Kind (R) = OE_Const then 266 S := L; 267 C := R; 268 elsif Get_Expr_Kind (L) = OE_Const then 269 S := R; 270 C := L; 271 else 272 raise Program_Error; 273 end if; 274 pragma Assert (Get_Expr_Mode (C) = Mode_U32); 275 Off := Off + To_Int32 (Get_Expr_Low (C)); 276 P := S; 277 end loop; 278 pragma Assert (Get_Expr_Kind (P) = OE_Addrd); 279 Sym := Get_Decl_Symbol (Get_Addr_Decl (P)); 280 Gen_Abs (Sym, Integer_32 (Off)); 281 end Gen_Imm_Addr; 282 283 -- Generate an immediat constant. 284 procedure Gen_Imm (N : O_Enode; Sz : Insn_Size) is 285 begin 286 case Get_Expr_Kind (N) is 287 when OE_Const => 288 case Sz is 289 when Sz_8 => 290 Gen_8 (Byte (Get_Expr_Low (N) and 16#FF#)); 291 when Sz_16 => 292 Gen_16 (Unsigned_32 (Get_Expr_Low (N) and 16#FF_FF#)); 293 when Sz_32 294 | Sz_32l => 295 Gen_32 (Unsigned_32 (Get_Expr_Low (N))); 296 when Sz_32h => 297 Gen_32 (Unsigned_32 (Get_Expr_High (N))); 298 when Sz_64 => 299 -- Immediates are sign extended. 300 pragma Assert (Is_Expr_S32 (N)); 301 Gen_32 (Unsigned_32 (Get_Expr_Low (N))); 302 end case; 303 when OE_Add 304 | OE_Addrd => 305 -- Only for 32-bit immediat. 306 pragma Assert (Sz = Sz_32); 307 Gen_Imm_Addr (N); 308 when others => 309 raise Program_Error; 310 end case; 311 end Gen_Imm; 312 313 function To_Reg32 (R : O_Reg) return Byte is 314 begin 315 pragma Assert (R in Regs_R32); 316 return O_Reg'Pos (R) - O_Reg'Pos (R_Ax); 317 end To_Reg32; 318 pragma Inline (To_Reg32); 319 320 function To_Reg64 (R : O_Reg) return Byte is 321 begin 322 pragma Assert (R in Regs_R64); 323 return Byte (O_Reg'Pos (R) - O_Reg'Pos (R_Ax)) and 7; 324 end To_Reg64; 325 pragma Inline (To_Reg64); 326 327 function To_Reg_Xmm (R : O_Reg) return Byte is 328 begin 329 return O_Reg'Pos (R) - O_Reg'Pos (R_Xmm0); 330 end To_Reg_Xmm; 331 pragma Inline (To_Reg_Xmm); 332 333 function To_Reg32 (R : O_Reg; Sz : Insn_Size) return Byte is 334 begin 335 case Sz is 336 when Sz_8 => 337 pragma Assert ((not Flags.M64 and R in Regs_R8) 338 or (Flags.M64 and R in Regs_R64)); 339 return To_Reg64 (R); 340 when Sz_16 => 341 pragma Assert (R in Regs_R32); 342 return To_Reg64 (R); 343 when Sz_32 => 344 pragma Assert ((not Flags.M64 and R in Regs_R32) 345 or (Flags.M64 and R in Regs_R64)); 346 return To_Reg64 (R); 347 when Sz_32l => 348 pragma Assert (not Flags.M64); 349 case R is 350 when R_Edx_Eax => 351 return 2#000#; 352 when R_Ebx_Ecx => 353 return 2#001#; 354 when R_Esi_Edi => 355 return 2#111#; 356 when others => 357 raise Program_Error; 358 end case; 359 when Sz_32h => 360 pragma Assert (not Flags.M64); 361 case R is 362 when R_Edx_Eax => 363 return 2#010#; 364 when R_Ebx_Ecx => 365 return 2#011#; 366 when R_Esi_Edi => 367 return 2#110#; 368 when others => 369 raise Program_Error; 370 end case; 371 when Sz_64 => 372 pragma Assert (R in Regs_R64); 373 return Byte (O_Reg'Pos (R) - O_Reg'Pos (R_Ax)) and 7; 374 end case; 375 end To_Reg32; 376 377 function To_Cond (R : O_Reg) return Byte is 378 begin 379 return O_Reg'Pos (R) - O_Reg'Pos (R_Ov); 380 end To_Cond; 381 pragma Inline (To_Cond); 382 383 function To_Reg (R : O_Reg; Sz : Insn_Size) return Byte is 384 begin 385 if R in Regs_Xmm then 386 return To_Reg_Xmm (R); 387 else 388 return To_Reg32 (R, Sz); 389 end if; 390 end To_Reg; 391 392 -- SIB + disp values. 393 SIB_Scale : Byte; 394 SIB_Index : O_Reg; 395 Rm_Base : O_Reg; 396 Rm_Offset : Int32; 397 Rm_Sym : Symbol; 398 399 -- If not R_Nil, the reg/opc field (bit 3-5) of the ModR/M byte is a 400 -- register. 401 Rm_Opc_Reg : O_Reg; 402 Rm_Opc_Sz : Insn_Size; 403 404 -- If not R_Nil, encode mod=11 (no memory access). All above variables 405 -- must be 0/R_Nil. 406 Rm_Reg : O_Reg; 407 Rm_Sz : Insn_Size; 408 409 procedure Gen_Rex_Mod_Rm 410 is 411 B : Byte; 412 begin 413 if Flags.M64 then 414 B := 0; 415 if Rm_Sz = Sz_64 then 416 B := B or Opc_Rex_W; 417 end if; 418 if Rm_Opc_Reg in Regs_R8_R15 419 or Rm_Opc_Reg in Regs_Xmm8_Xmm15 420 then 421 B := B or Opc_Rex_R; 422 end if; 423 if Rm_Reg in Regs_R8_R15 424 or Rm_Reg in Regs_Xmm8_Xmm15 425 or Rm_Base in Regs_R8_R15 426 then 427 B := B or Opc_Rex_B; 428 end if; 429 if SIB_Index in Regs_R8_R15 then 430 B := B or Opc_Rex_X; 431 end if; 432 if B /= 0 then 433 Gen_8 (B); 434 end if; 435 end if; 436 end Gen_Rex_Mod_Rm; 437 438 procedure Fill_Sib (N : O_Enode) 439 is 440 use Ortho_Code.Decls; 441 Reg : constant O_Reg := Get_Expr_Reg (N); 442 begin 443 -- A simple register. 444 if Reg in Regs_R64 then 445 if Rm_Base = R_Nil then 446 Rm_Base := Reg; 447 elsif SIB_Index = R_Nil then 448 SIB_Index := Reg; 449 else 450 -- It is not possible to add 3 registers with SIB. 451 raise Program_Error; 452 end if; 453 return; 454 end if; 455 456 case Get_Expr_Kind (N) is 457 when OE_Indir => 458 Fill_Sib (Get_Expr_Operand (N)); 459 when OE_Addrl => 460 declare 461 Frame : constant O_Enode := Get_Addrl_Frame (N); 462 begin 463 if Frame = O_Enode_Null then 464 -- Local frame: use the frame pointer. 465 Rm_Base := R_Bp; 466 else 467 -- In an outer frame: use the computed frame register. 468 Rm_Base := Get_Expr_Reg (Frame); 469 end if; 470 end; 471 Rm_Offset := Rm_Offset + Get_Local_Offset (Get_Addr_Decl (N)); 472 when OE_Addrd => 473 -- Cannot add two symbols. 474 pragma Assert (Rm_Sym = Null_Symbol); 475 Rm_Sym := Get_Decl_Symbol (Get_Addr_Decl (N)); 476 when OE_Add => 477 Fill_Sib (Get_Expr_Left (N)); 478 Fill_Sib (Get_Expr_Right (N)); 479 when OE_Const => 480 Rm_Offset := Rm_Offset + To_Int32 (Get_Expr_Low (N)); 481 when OE_Shl => 482 -- Only one scale. 483 pragma Assert (SIB_Index = R_Nil); 484 SIB_Index := Get_Expr_Reg (Get_Expr_Left (N)); 485 SIB_Scale := Byte (Get_Expr_Low (Get_Expr_Right (N))); 486 when others => 487 Error_Emit ("fill_sib", N); 488 end case; 489 end Fill_Sib; 490 491 -- Write the SIB byte. 492 procedure Gen_Sib 493 is 494 Base : Byte; 495 begin 496 if Rm_Base = R_Nil then 497 Base := 2#101#; -- BP 498 else 499 pragma Assert (not (SIB_Index = R_Sp 500 and (Rm_Base = R_Bp or Rm_Base = R_R13))); 501 Base := To_Reg64 (Rm_Base); 502 end if; 503 Gen_8 504 (SIB_Scale * 2#1_000_000# + To_Reg64 (SIB_Index) * 2#1_000# + Base); 505 end Gen_Sib; 506 507 -- ModRM is a register. 508 procedure Init_Modrm_Reg (Reg : O_Reg; 509 Sz : Insn_Size; 510 Opc : O_Reg := R_Nil; 511 Opc_Sz : Insn_Size := Sz_32) is 512 begin 513 Rm_Base := R_Nil; 514 SIB_Index := R_Nil; 515 SIB_Scale := 0; 516 Rm_Sym := Null_Symbol; 517 Rm_Offset := 0; 518 519 Rm_Opc_Reg := Opc; 520 Rm_Opc_Sz := Opc_Sz; 521 522 Rm_Reg := Reg; 523 Rm_Sz := Sz; 524 525 Gen_Rex_Mod_Rm; 526 end Init_Modrm_Reg; 527 528 -- Note: SZ is not relevant. 529 procedure Init_Modrm_Sym (Sym : Symbol; Sz : Insn_Size; Opc_Reg : O_Reg) is 530 begin 531 Rm_Base := R_Nil; 532 SIB_Index := R_Nil; 533 SIB_Scale := 0; 534 Rm_Sym := Sym; 535 Rm_Offset := 0; 536 537 Rm_Opc_Reg := Opc_Reg; 538 Rm_Opc_Sz := Sz; 539 540 Rm_Reg := R_Nil; 541 Rm_Sz := Sz; 542 543 Gen_Rex_Mod_Rm; 544 end Init_Modrm_Sym; 545 546 -- ModRM is a memory reference. 547 procedure Init_Modrm_Mem (N : O_Enode; Sz : Insn_Size; Opc : O_Reg := R_Nil) 548 is 549 Reg : constant O_Reg := Get_Expr_Reg (N); 550 begin 551 Rm_Base := R_Nil; 552 SIB_Index := R_Nil; 553 Rm_Reg := R_Nil; 554 Rm_Sz := Sz; 555 556 Rm_Opc_Reg := Opc; 557 Rm_Opc_Sz := Sz; 558 559 if Sz = Sz_32h then 560 Rm_Offset := 4; 561 else 562 Rm_Offset := 0; 563 end if; 564 SIB_Scale := 0; 565 Rm_Sym := Null_Symbol; 566 case Reg is 567 when R_Mem 568 | R_Imm 569 | R_Eq 570 | R_B_Off 571 | R_B_I 572 | R_I_Off 573 | R_Sib => 574 Fill_Sib (N); 575 when Regs_R64 => 576 Rm_Base := Reg; 577 when R_Spill => 578 Rm_Base := R_Bp; 579 Rm_Offset := Rm_Offset + Get_Spill_Info (N); 580 when others => 581 Error_Emit ("init_modrm_mem: unhandled reg", N); 582 end case; 583 584 Gen_Rex_Mod_Rm; 585 end Init_Modrm_Mem; 586 587 procedure Init_Modrm_Expr 588 (N : O_Enode; Sz : Insn_Size; Opc : O_Reg := R_Nil) 589 is 590 Reg : constant O_Reg := Get_Expr_Reg (N); 591 begin 592 case Reg is 593 when Regs_R64 594 | Regs_Pair 595 | Regs_Xmm => 596 -- Destination is a register. 597 Init_Modrm_Reg (Reg, Sz, Opc, Sz); 598 when others => 599 -- Destination is an effective address. 600 Init_Modrm_Mem (N, Sz, Opc); 601 end case; 602 end Init_Modrm_Expr; 603 604 procedure Init_Modrm_Offset 605 (Base : O_Reg; Off : Int32; Sz : Insn_Size; Opc : O_Reg := R_Nil) is 606 begin 607 SIB_Index := R_Nil; 608 SIB_Scale := 0; 609 Rm_Reg := R_Nil; 610 Rm_Sym := Null_Symbol; 611 Rm_Sz := Sz; 612 613 Rm_Base := Base; 614 615 Rm_Opc_Reg := Opc; 616 Rm_Opc_Sz := Sz; 617 618 if Sz = Sz_32h then 619 Rm_Offset := Off + 4; 620 else 621 Rm_Offset := Off; 622 end if; 623 624 Gen_Rex_Mod_Rm; 625 end Init_Modrm_Offset; 626 627 -- Generate an R/M (+ SIB) byte. 628 -- R is added to the R/M byte. 629 procedure Gen_Mod_Rm_B (R : Byte) is 630 begin 631 if Rm_Reg /= R_Nil then 632 -- Register: mod = 11, no memory access. 633 pragma Assert (Rm_Base = R_Nil); 634 pragma Assert (Rm_Sym = Null_Symbol); 635 pragma Assert (Rm_Offset = 0); 636 pragma Assert (SIB_Index = R_Nil); 637 Gen_8 (2#11_000_000# + R + To_Reg (Rm_Reg, Rm_Sz)); 638 return; 639 end if; 640 641 if SIB_Index /= R_Nil or (Flags.M64 and Rm_Base = R_R12) then 642 -- With SIB. 643 if SIB_Index = R_Nil then 644 SIB_Index := R_Sp; 645 end if; 646 if Rm_Base = R_Nil then 647 -- No base (but index). Use the special encoding with base=BP. 648 Gen_8 (2#00_000_100# + R); -- mod=00, rm=SP -> disp32. 649 Rm_Base := R_Bp; 650 Gen_Sib; 651 if Rm_Sym = Null_Symbol then 652 Gen_32 (Unsigned_32 (To_Uns32 (Rm_Offset))); 653 else 654 pragma Assert (not Flags.M64); 655 Gen_X86_32 (Rm_Sym, Integer_32 (Rm_Offset)); 656 end if; 657 elsif Rm_Sym = Null_Symbol and Rm_Offset = 0 658 and Rm_Base /= R_Bp and Rm_Base /= R_R13 659 then 660 -- No offset (only allowed if base is not BP). 661 Gen_8 (2#00_000_100# + R); 662 Gen_Sib; 663 elsif Rm_Sym = Null_Symbol and Rm_Offset in -128 .. 127 then 664 -- Disp8 665 Gen_8 (2#01_000_100# + R); 666 Gen_Sib; 667 Gen_8 (Byte (To_Uns32 (Rm_Offset) and 16#Ff#)); 668 else 669 -- Disp32 670 Gen_8 (2#10_000_100# + R); 671 Gen_Sib; 672 if Rm_Sym = Null_Symbol then 673 Gen_32 (Unsigned_32 (To_Uns32 (Rm_Offset))); 674 else 675 pragma Assert (not Flags.M64); 676 Gen_X86_32 (Rm_Sym, Integer_32 (Rm_Offset)); 677 end if; 678 end if; 679 else 680 case Rm_Base is 681 when R_Sp => 682 -- It isn't possible to use SP as a base register without using 683 -- an SIB encoding. 684 raise Program_Error; 685 when R_Nil => 686 -- There should be no case where the offset is negative. 687 pragma Assert (Rm_Offset >= 0); 688 -- Encode for disp32 (Mod=00, R/M=101) or RIP relative 689 Gen_8 (2#00_000_101# + R); 690 if Flags.M64 then 691 -- RIP relative 692 Gen_X86_Pc32 (Rm_Sym, Unsigned_32 (Rm_Offset)); 693 else 694 -- Disp32. 695 Gen_X86_32 (Rm_Sym, Integer_32 (Rm_Offset)); 696 end if; 697 when R_Ax 698 | R_Bx 699 | R_Cx 700 | R_Dx 701 | R_Bp 702 | R_Si 703 | R_Di 704 | R_R8 .. R_R11 705 | R_R13 .. R_R15 => 706 if Rm_Offset = 0 and Rm_Sym = Null_Symbol 707 and Rm_Base /= R_Bp and Rm_Base /= R_R13 708 then 709 -- No disp: use Mod=00 (not supported if base is BP or R13). 710 Gen_8 (2#00_000_000# + R + To_Reg64 (Rm_Base)); 711 elsif Rm_Sym = Null_Symbol 712 and Rm_Offset <= 127 and Rm_Offset >= -128 713 then 714 -- Disp8 (Mod=01) 715 Gen_8 (2#01_000_000# + R + To_Reg64 (Rm_Base)); 716 Gen_8 (Byte (To_Uns32 (Rm_Offset) and 16#Ff#)); 717 else 718 -- Disp32 (Mod=10) 719 Gen_8 (2#10_000_000# + R + To_Reg64 (Rm_Base)); 720 if Rm_Sym = Null_Symbol then 721 Gen_32 (Unsigned_32 (To_Uns32 (Rm_Offset))); 722 else 723 pragma Assert (not Flags.M64); 724 Gen_X86_32 (Rm_Sym, Integer_32 (Rm_Offset)); 725 end if; 726 end if; 727 when others => 728 raise Program_Error; 729 end case; 730 end if; 731 end Gen_Mod_Rm_B; 732 733 procedure Gen_Mod_Rm_Opc (R : Byte) is 734 begin 735 pragma Assert (Rm_Opc_Reg = R_Nil); 736 Gen_Mod_Rm_B (R); 737 end Gen_Mod_Rm_Opc; 738 739 procedure Gen_Mod_Rm_Reg is 740 begin 741 pragma Assert (Rm_Opc_Reg /= R_Nil); 742 Gen_Mod_Rm_B (To_Reg (Rm_Opc_Reg, Rm_Opc_Sz) * 8); 743 end Gen_Mod_Rm_Reg; 744 745 procedure Gen_Grp1_Insn (Op : Byte; Stmt : O_Enode; Sz : Insn_Size) 746 is 747 L : constant O_Enode := Get_Expr_Left (Stmt); 748 R : constant O_Enode := Get_Expr_Right (Stmt); 749 Lr : constant O_Reg := Get_Expr_Reg (L); 750 Rr : constant O_Reg := Get_Expr_Reg (R); 751 begin 752 Start_Insn; 753 case Rr is 754 when R_Imm => 755 if Lr = R_Ax then 756 -- Use compact encoding. 757 if Sz = Sz_64 then 758 Gen_8 (Opc_Rex_W); 759 end if; 760 Gen_Insn_Sz (2#000_000_100# + Op, Sz); 761 Gen_Imm (R, Sz); 762 elsif Is_Imm8 (R, Sz) then 763 Init_Modrm_Expr (L, Sz); 764 Gen_Insn_Sz_S8 (16#80#, Sz); 765 Gen_Mod_Rm_Opc (Op); 766 Gen_Imm8 (R, Sz); 767 else 768 Init_Modrm_Expr (L, Sz); 769 Gen_Insn_Sz (16#80#, Sz); 770 Gen_Mod_Rm_Opc (Op); 771 Gen_Imm (R, Sz); 772 end if; 773 when R_Mem 774 | R_Spill 775 | Regs_R64 776 | Regs_Pair => 777 Init_Modrm_Expr (R, Sz, Lr); 778 Gen_Insn_Sz (2#00_000_010# + Op, Sz); 779 Gen_Mod_Rm_Reg; 780 when others => 781 Error_Emit ("emit_op", Stmt); 782 end case; 783 End_Insn; 784 end Gen_Grp1_Insn; 785 786 -- Emit a one byte instruction. 787 procedure Gen_1 (B : Byte) is 788 begin 789 Start_Insn; 790 Gen_8 (B); 791 End_Insn; 792 end Gen_1; 793 794 -- Emit a two byte instruction. 795 procedure Gen_2 (B1, B2 : Byte) is 796 begin 797 Start_Insn; 798 Gen_8 (B1); 799 Gen_8 (B2); 800 End_Insn; 801 end Gen_2; 802 803 -- Grp1 instructions have a mod/rm and an immediate value VAL. 804 -- Mod/Rm must be initialized. 805 procedure Gen_Insn_Grp1 (Opc2 : Byte; Val : Int32) is 806 begin 807 if Val in -128 .. 127 then 808 case Rm_Sz is 809 when Sz_8 => 810 Gen_8 (Opc_Grp1b_Rm_Imm8); 811 when Sz_16 => 812 Gen_8 (Opc_Data16); 813 Gen_8 (Opc_Grp1v_Rm_Imm8); 814 when Sz_32 815 | Sz_32l 816 | Sz_32h 817 | Sz_64 => 818 Gen_8 (Opc_Grp1v_Rm_Imm8); 819 end case; 820 Gen_Mod_Rm_Opc (Opc2); 821 Gen_8 (Byte (To_Uns32 (Val) and 16#Ff#)); 822 else 823 case Rm_Sz is 824 when Sz_8 => 825 pragma Assert (False); 826 null; 827 when Sz_16 => 828 Gen_8 (Opc_Data16); 829 Gen_8 (Opc_Grp1v_Rm_Imm32); 830 when Sz_32 831 | Sz_32l 832 | Sz_32h 833 | Sz_64 => 834 Gen_8 (Opc_Grp1v_Rm_Imm32); 835 end case; 836 Gen_Mod_Rm_Opc (Opc2); 837 Gen_32 (Unsigned_32 (To_Uns32 (Val))); 838 end if; 839 end Gen_Insn_Grp1; 840 841 procedure Gen_Cdq (Sz : Insn_Size) is 842 begin 843 Start_Insn; 844 if Sz = Sz_64 then 845 Gen_8 (Opc_Rex_W); 846 end if; 847 Gen_8 (Opc_Cdq); 848 End_Insn; 849 end Gen_Cdq; 850 851 procedure Gen_Clear_Edx is 852 begin 853 -- Xorl edx, edx 854 Gen_2 (Opc_Xorl_Rm_Reg, 2#11_010_010#); 855 end Gen_Clear_Edx; 856 857 procedure Gen_Grp3_Insn (Op : Byte; Val : O_Enode; Sz : Insn_Size) is 858 begin 859 Start_Insn; 860 -- Unary Group 3 (test, not, neg...) 861 Init_Modrm_Expr (Val, Sz); 862 Gen_Insn_Sz (Opc_Grp3_Width, Sz); 863 Gen_Mod_Rm_Opc (Op); 864 End_Insn; 865 end Gen_Grp3_Insn; 866 867 procedure Gen_Grp3_Insn_Stmt (Op : Byte; Stmt : O_Enode; Sz : Insn_Size) 868 is 869 begin 870 Gen_Grp3_Insn (Op, Get_Expr_Operand (Stmt), Sz); 871 end Gen_Grp3_Insn_Stmt; 872 873 procedure Emit_Load_Imm (Stmt : O_Enode; Sz : Insn_Size) 874 is 875 Tr : constant O_Reg := Get_Expr_Reg (Stmt); 876 begin 877 Start_Insn; 878 -- TODO: handle 0 specially: use xor 879 -- Mov immediate. 880 case Sz is 881 when Sz_8 => 882 Gen_Rex_B (Tr, Sz); 883 Gen_8 (Opc_Movb_Imm_Reg + To_Reg32 (Tr, Sz)); 884 Gen_Imm (Stmt, Sz); 885 when Sz_16 => 886 Gen_8 (Opc_Data16); 887 Gen_8 (Opc_Movl_Imm_Reg + To_Reg32 (Tr, Sz)); 888 Gen_Imm (Stmt, Sz); 889 when Sz_32 890 | Sz_32l 891 | Sz_32h => 892 Gen_Rex_B (Tr, Sz); 893 Gen_8 (Opc_Movl_Imm_Reg + To_Reg32 (Tr, Sz)); 894 Gen_Imm (Stmt, Sz); 895 when Sz_64 => 896 if Get_Expr_Kind (Stmt) = OE_Const then 897 if Get_Expr_High (Stmt) = 0 then 898 Gen_Rex_B (Tr, Sz_32); 899 Gen_8 (Opc_Movl_Imm_Reg + To_Reg32 (Tr, Sz)); 900 Gen_32 (Unsigned_32 (Get_Expr_Low (Stmt))); 901 else 902 Gen_Rex_B (Tr, Sz_64); 903 Gen_8 (Opc_Movl_Imm_Reg + To_Reg32 (Tr, Sz)); 904 Gen_32 (Unsigned_32 (Get_Expr_Low (Stmt))); 905 Gen_32 (Unsigned_32 (Get_Expr_High (Stmt))); 906 end if; 907 else 908 Gen_Rex_B (Tr, Sz_64); 909 Gen_8 (Opc_Movl_Imm_Reg + To_Reg32 (Tr, Sz)); 910 Gen_Imm_Addr (Stmt); 911 end if; 912 end case; 913 End_Insn; 914 end Emit_Load_Imm; 915 916 function Mode_Fp_To_Mf (Mode : Mode_Fp) return Byte is 917 begin 918 case Mode is 919 when Mode_F32 => 920 return 2#00_0#; 921 when Mode_F64 => 922 return 2#10_0#; 923 end case; 924 end Mode_Fp_To_Mf; 925 926 subtype Nat_Align is Natural range 0 .. 4; 927 928 function Gen_Constant_Start (Log2sz : Nat_Align) return Symbol 929 is 930 Sym : Symbol; 931 begin 932 -- Write the constant in .rodata 933 Set_Current_Section (Sect_Rodata); 934 Gen_Pow_Align (Log2sz); 935 Prealloc (2 ** Log2sz); 936 Sym := Create_Local_Symbol; 937 Set_Symbol_Pc (Sym, False); 938 return Sym; 939 end Gen_Constant_Start; 940 941 function Gen_Constant_32 (Val : Unsigned_32) return Symbol 942 is 943 Sym : Symbol; 944 begin 945 Sym := Gen_Constant_Start (2); 946 Gen_32 (Val); 947 Set_Current_Section (Sect_Text); 948 return Sym; 949 end Gen_Constant_32; 950 951 function Gen_Constant_64 (Lo, Hi : Unsigned_32) return Symbol 952 is 953 Sym : Symbol; 954 begin 955 Sym := Gen_Constant_Start (3); 956 Gen_32 (Lo); 957 Gen_32 (Hi); 958 Set_Current_Section (Sect_Text); 959 return Sym; 960 end Gen_Constant_64; 961 962 function Gen_Constant_128 (Lo, Hi : Unsigned_32) return Symbol 963 is 964 Sym : Symbol; 965 begin 966 Sym := Gen_Constant_Start (4); 967 Gen_32 (Lo); 968 Gen_32 (Hi); 969 Gen_32 (Lo); 970 Gen_32 (Hi); 971 Set_Current_Section (Sect_Text); 972 return Sym; 973 end Gen_Constant_128; 974 975 Xmm_Sign32_Sym : Symbol := Null_Symbol; 976 Xmm_Sign64_Sym : Symbol := Null_Symbol; 977 978 function Get_Xmm_Sign_Constant (Mode : Mode_Fp) return Symbol is 979 begin 980 case Mode is 981 when Mode_F32 => 982 if Xmm_Sign32_Sym = Null_Symbol then 983 Xmm_Sign32_Sym := Gen_Constant_128 984 (16#8000_0000#, 16#8000_0000#); 985 end if; 986 return Xmm_Sign32_Sym; 987 when Mode_F64 => 988 if Xmm_Sign64_Sym = Null_Symbol then 989 Xmm_Sign64_Sym := Gen_Constant_128 990 (0, 16#8000_0000#); 991 end if; 992 return Xmm_Sign64_Sym; 993 end case; 994 end Get_Xmm_Sign_Constant; 995 996 Xmm_Mask32_Sym : Symbol := Null_Symbol; 997 Xmm_Mask64_Sym : Symbol := Null_Symbol; 998 999 function Get_Xmm_Mask_Constant (Mode : Mode_Fp) return Symbol is 1000 begin 1001 case Mode is 1002 when Mode_F32 => 1003 if Xmm_Mask32_Sym = Null_Symbol then 1004 Xmm_Mask32_Sym := Gen_Constant_128 1005 (16#7fff_ffff#, 16#7fff_ffff#); 1006 end if; 1007 return Xmm_Mask32_Sym; 1008 when Mode_F64 => 1009 if Xmm_Mask64_Sym = Null_Symbol then 1010 Xmm_Mask64_Sym := Gen_Constant_128 1011 (16#ffff_ffff#, 16#7fff_ffff#); 1012 end if; 1013 return Xmm_Mask64_Sym; 1014 end case; 1015 end Get_Xmm_Mask_Constant; 1016 1017 procedure Gen_SSE_Prefix (Mode : Mode_Fp) is 1018 begin 1019 case Mode is 1020 when Mode_F32 => 1021 Gen_8 (16#f3#); 1022 when Mode_F64 => 1023 Gen_8 (16#f2#); 1024 end case; 1025 end Gen_SSE_Prefix; 1026 1027 procedure Gen_SSE_Opc (Op : Byte) is 1028 begin 1029 Gen_8 (16#0f#, Op); 1030 end Gen_SSE_Opc; 1031 1032 procedure Gen_SSE_D16_Opc (Mode : Mode_Fp; Opc : Byte) is 1033 begin 1034 case Mode is 1035 when Mode_F32 => 1036 null; 1037 when Mode_F64 => 1038 Gen_8 (Opc_Data16); 1039 end case; 1040 Gen_8 (16#0f#); 1041 Gen_8 (Opc); 1042 end Gen_SSE_D16_Opc; 1043 1044 procedure Emit_Load_Fp (Stmt : O_Enode; Mode : Mode_Fp) 1045 is 1046 Sym : Symbol; 1047 R : O_Reg; 1048 Lo : constant Unsigned_32 := Unsigned_32 (Get_Expr_Low (Stmt)); 1049 begin 1050 case Mode is 1051 when Mode_F32 => 1052 Sym := Gen_Constant_32 (Lo); 1053 when Mode_F64 => 1054 Sym := Gen_Constant_64 (Lo, Unsigned_32 (Get_Expr_High (Stmt))); 1055 end case; 1056 1057 -- Load the constant. 1058 R := Get_Expr_Reg (Stmt); 1059 case R is 1060 when R_St0 => 1061 Start_Insn; 1062 Gen_8 (2#11011_001# + Mode_Fp_To_Mf (Mode)); 1063 Gen_8 (2#00_000_101#); 1064 Gen_X86_32 (Sym, 0); 1065 End_Insn; 1066 when Regs_Xmm => 1067 Start_Insn; 1068 Gen_SSE_Prefix (Mode); 1069 Gen_SSE_Opc (Opc_Movsd_Xmm_M64); 1070 Gen_8 (2#00_000_101# + To_Reg_Xmm (R) * 2#1_000#); 1071 if Flags.M64 then 1072 -- RIP relative 1073 Gen_X86_Pc32 (Sym, 0); 1074 else 1075 -- Disp32. 1076 Gen_X86_32 (Sym, 0); 1077 end if; 1078 End_Insn; 1079 when others => 1080 raise Program_Error; 1081 end case; 1082 end Emit_Load_Fp; 1083 1084 procedure Emit_Load_Fp_Mem (Stmt : O_Enode; Mode : Mode_Fp) 1085 is 1086 Dest : constant O_Reg := Get_Expr_Reg (Stmt); 1087 begin 1088 if Dest in Regs_Xmm then 1089 Start_Insn; 1090 Gen_SSE_Prefix (Mode); 1091 Init_Modrm_Mem (Get_Expr_Operand (Stmt), Sz_Fp, Dest); 1092 Gen_SSE_Opc (Opc_Movsd_Xmm_M64); 1093 Gen_Mod_Rm_Reg; 1094 End_Insn; 1095 else 1096 Start_Insn; 1097 Init_Modrm_Mem (Get_Expr_Operand (Stmt), Sz_Fp); 1098 Gen_8 (2#11011_001# + Mode_Fp_To_Mf (Mode)); 1099 Gen_Mod_Rm_Opc (2#000_000#); 1100 End_Insn; 1101 end if; 1102 end Emit_Load_Fp_Mem; 1103 1104 procedure Emit_Load_Mem (Stmt : O_Enode; Sz : Insn_Size) 1105 is 1106 Tr : constant O_Reg := Get_Expr_Reg (Stmt); 1107 Val : constant O_Enode := Get_Expr_Operand (Stmt); 1108 begin 1109 case Tr is 1110 when Regs_R64 1111 | Regs_Pair => 1112 -- mov REG, OP 1113 Start_Insn; 1114 Init_Modrm_Mem (Val, Sz, Tr); 1115 Gen_Insn_Sz (Opc_Mov_Reg_Rm, Sz); 1116 Gen_Mod_Rm_Reg; 1117 End_Insn; 1118 when R_Eq => 1119 -- Cmp OP, 1 1120 Start_Insn; 1121 Init_Modrm_Mem (Val, Sz); 1122 Gen_Insn_Grp1 (Opc2_Grp1_Cmp, 1); 1123 End_Insn; 1124 when others => 1125 Error_Emit ("emit_load_mem", Stmt); 1126 end case; 1127 end Emit_Load_Mem; 1128 1129 procedure Emit_Store (Stmt : O_Enode; Sz : Insn_Size) 1130 is 1131 T : constant O_Enode := Get_Assign_Target (Stmt); 1132 R : constant O_Enode := Get_Expr_Operand (Stmt); 1133 Tr : constant O_Reg := Get_Expr_Reg (T); 1134 Rr : constant O_Reg := Get_Expr_Reg (R); 1135 B : Byte; 1136 begin 1137 Start_Insn; 1138 case Rr is 1139 when R_Imm => 1140 if False and (Tr in Regs_R64 or Tr in Regs_Pair) then 1141 B := 2#1011_1_000#; 1142 case Sz is 1143 when Sz_8 => 1144 B := B and not 2#0000_1_000#; 1145 when Sz_16 => 1146 Gen_8 (16#66#); 1147 when Sz_32 1148 | Sz_32l 1149 | Sz_32h 1150 | Sz_64 => 1151 null; 1152 end case; 1153 Gen_8 (B + To_Reg32 (Tr, Sz)); 1154 else 1155 Init_Modrm_Mem (T, Sz); 1156 Gen_Insn_Sz (Opc_Mov_Rm_Imm, Sz); 1157 Gen_Mod_Rm_Opc (16#00#); 1158 end if; 1159 Gen_Imm (R, Sz); 1160 when Regs_R64 1161 | Regs_Pair => 1162 Init_Modrm_Mem (T, Sz, Rr); 1163 Gen_Insn_Sz (Opc_Mov_Rm_Reg, Sz); 1164 Gen_Mod_Rm_Reg; 1165 when others => 1166 Error_Emit ("emit_store", Stmt); 1167 end case; 1168 End_Insn; 1169 end Emit_Store; 1170 1171 procedure Emit_Store_Fp (Stmt : O_Enode; Mode : Mode_Fp) is 1172 begin 1173 -- fstp 1174 Start_Insn; 1175 Init_Modrm_Mem (Get_Assign_Target (Stmt), Sz_Ptr); 1176 Gen_8 (2#11011_00_1# + Mode_Fp_To_Mf (Mode)); 1177 Gen_Mod_Rm_Opc (2#011_000#); 1178 End_Insn; 1179 end Emit_Store_Fp; 1180 1181 procedure Emit_Store_Xmm (Stmt : O_Enode; Mode : Mode_Fp) is 1182 begin 1183 -- movsd 1184 Start_Insn; 1185 Gen_SSE_Prefix (Mode); 1186 Init_Modrm_Mem (Get_Assign_Target (Stmt), Sz_Fp, 1187 Get_Expr_Reg (Get_Expr_Operand (Stmt))); 1188 Gen_SSE_Opc (Opc_Movsd_M64_Xmm); 1189 Gen_Mod_Rm_Reg; 1190 End_Insn; 1191 end Emit_Store_Xmm; 1192 1193 procedure Gen_Push_Pop_Reg (Opc : Byte; Reg : O_Reg; Sz : Insn_Size) is 1194 begin 1195 Start_Insn; 1196 if Reg in Regs_R8_R15 then 1197 Gen_8 (Opc_Rex_B); 1198 end if; 1199 Gen_8 (Opc + To_Reg32 (Reg, Sz)); 1200 End_Insn; 1201 end Gen_Push_Pop_Reg; 1202 1203 procedure Emit_Push (Val : O_Enode; Sz : Insn_Size) 1204 is 1205 R : constant O_Reg := Get_Expr_Reg (Val); 1206 begin 1207 case R is 1208 when R_Imm => 1209 Start_Insn; 1210 if Is_Imm8 (Val, Sz) then 1211 Gen_8 (Opc_Push_Imm8); 1212 Gen_Imm8 (Val, Sz); 1213 else 1214 Gen_8 (Opc_Push_Imm); 1215 Gen_Imm (Val, Sz); 1216 end if; 1217 End_Insn; 1218 when Regs_R64 1219 | Regs_Pair => 1220 Gen_Push_Pop_Reg (Opc_Push_Reg, R, Sz); 1221 when others => 1222 Start_Insn; 1223 Init_Modrm_Expr (Val, Sz); 1224 Gen_8 (Opc_Grp5); 1225 Gen_Mod_Rm_Opc (Opc2_Grp5_Push_Rm); 1226 End_Insn; 1227 end case; 1228 end Emit_Push; 1229 1230 procedure Emit_Subl_Sp_Imm (Len : Byte) is 1231 begin 1232 Start_Insn; 1233 Gen_Rex (Opc_Rex_W); 1234 Gen_8 (Opc_Grp1v_Rm_Imm8); 1235 Gen_8 (Opc2_Grp1_Sub + 2#11_000_100#); 1236 Gen_8 (Len); 1237 End_Insn; 1238 end Emit_Subl_Sp_Imm; 1239 1240 procedure Emit_Addl_Sp_Imm (Len : Byte) 1241 is 1242 pragma Assert (not Flags.M64); 1243 begin 1244 Start_Insn; 1245 Gen_8 (Opc_Grp1v_Rm_Imm8); 1246 Gen_8 (Opc2_Grp1_Add + 2#11_000_100#); 1247 Gen_8 (Len); 1248 End_Insn; 1249 end Emit_Addl_Sp_Imm; 1250 1251 procedure Emit_Push_Fp (Op : O_Enode; Mode : Mode_Fp) 1252 is 1253 Reg : constant O_Reg := Get_Expr_Reg (Op); 1254 Len : Byte; 1255 begin 1256 -- subl esp, val 1257 case Mode is 1258 when Mode_F32 => 1259 Len := 4; 1260 when Mode_F64 => 1261 Len := 8; 1262 end case; 1263 Emit_Subl_Sp_Imm (Len); 1264 1265 if Reg = R_St0 then 1266 -- fstp st, (esp) 1267 Start_Insn; 1268 Gen_8 (2#11011_001# + Mode_Fp_To_Mf (Mode)); 1269 Gen_8 (2#00_011_100#); -- Modrm: SIB, no disp 1270 Gen_8 (2#00_100_100#); -- SIB: SS=0, no index, base=esp 1271 End_Insn; 1272 else 1273 pragma Assert (Reg in Regs_Xmm); 1274 Start_Insn; 1275 Gen_SSE_Prefix (Mode); 1276 Gen_SSE_Opc (Opc_Movsd_M64_Xmm); 1277 Gen_8 (To_Reg_Xmm (Reg) * 8 + 2#00_000_100#); -- Modrm: [--] 1278 Gen_8 (2#00_100_100#); -- SIB: SS=0, no index, base=esp 1279 End_Insn; 1280 end if; 1281 end Emit_Push_Fp; 1282 1283 function Prepare_Label (Label : O_Enode) return Symbol 1284 is 1285 Sym : Symbol; 1286 begin 1287 Sym := Get_Label_Symbol (Label); 1288 if Sym = Null_Symbol then 1289 Sym := Create_Local_Symbol; 1290 Set_Label_Symbol (Label, Sym); 1291 end if; 1292 return Sym; 1293 end Prepare_Label; 1294 1295 procedure Emit_Jmp_T (Stmt : O_Enode; Reg : O_Reg) 1296 is 1297 Sym : Symbol; 1298 Val : Pc_Type; 1299 Opc : Byte; 1300 begin 1301 Sym := Prepare_Label (Get_Jump_Label (Stmt)); 1302 Val := Get_Symbol_Value (Sym); 1303 Start_Insn; 1304 Opc := To_Cond (Reg); 1305 if Val = 0 then 1306 -- Assume long jmp. 1307 Gen_8 (Opc_0f); 1308 Gen_8 (Opc2_0f_Jcc + Opc); 1309 Gen_X86_Pc32 (Sym, 0); 1310 else 1311 if Val + 128 < Get_Current_Pc + 4 then 1312 -- Long jmp. 1313 Gen_8 (Opc_0f); 1314 Gen_8 (Opc2_0f_Jcc + Opc); 1315 Gen_32 (To_Unsigned_32 (Val - (Get_Current_Pc + 4))); 1316 else 1317 -- short jmp. 1318 Gen_8 (Opc_Jcc + Opc); 1319 Gen_8 (Byte (Val - (Get_Current_Pc + 1))); 1320 end if; 1321 end if; 1322 End_Insn; 1323 end Emit_Jmp_T; 1324 1325 procedure Emit_Jmp (Stmt : O_Enode) 1326 is 1327 Sym : Symbol; 1328 Val : Pc_Type; 1329 begin 1330 Sym := Prepare_Label (Get_Jump_Label (Stmt)); 1331 Val := Get_Symbol_Value (Sym); 1332 Start_Insn; 1333 if Val = 0 then 1334 -- Assume long jmp. 1335 Gen_8 (Opc_Jmp_Long); 1336 Gen_X86_Pc32 (Sym, 0); 1337 else 1338 if Val + 128 < Get_Current_Pc + 4 then 1339 -- Long jmp. 1340 Gen_8 (Opc_Jmp_Long); 1341 Gen_32 (To_Unsigned_32 (Val - (Get_Current_Pc + 4))); 1342 else 1343 -- short jmp. 1344 Gen_8 (Opc_Jmp_Short); 1345 Gen_8 (Byte ((Val - (Get_Current_Pc + 1)) and 16#Ff#)); 1346 end if; 1347 end if; 1348 End_Insn; 1349 end Emit_Jmp; 1350 1351 procedure Emit_Label (Stmt : O_Enode) 1352 is 1353 Sym : Symbol; 1354 begin 1355 Sym := Prepare_Label (Stmt); 1356 Set_Symbol_Pc (Sym, False); 1357 end Emit_Label; 1358 1359 procedure Gen_Call (Sym : Symbol) is 1360 begin 1361 Start_Insn; 1362 Gen_8 (Opc_Call); 1363 Gen_X86_Pc32 (Sym, 0); 1364 End_Insn; 1365 end Gen_Call; 1366 1367 procedure Emit_Stack_Adjust (Stmt : O_Enode) 1368 is 1369 Val : constant Int32 := Get_Stack_Adjust (Stmt); 1370 begin 1371 if Val > 0 then 1372 -- subl esp, val 1373 Emit_Subl_Sp_Imm (Byte (Val)); 1374 elsif Val < 0 then 1375 Start_Insn; 1376 Init_Modrm_Reg (R_Sp, Sz_Ptr); 1377 Gen_Insn_Grp1 (Opc2_Grp1_Add, -Val); 1378 End_Insn; 1379 end if; 1380 end Emit_Stack_Adjust; 1381 1382 procedure Emit_Call (Stmt : O_Enode) 1383 is 1384 Subprg : constant O_Dnode := Get_Call_Subprg (Stmt); 1385 Sym : constant Symbol := Get_Decl_Symbol (Subprg); 1386 Mode : constant Mode_Type := Get_Expr_Mode (Stmt); 1387 begin 1388 Gen_Call (Sym); 1389 1390 if Abi.Flag_Sse2 and then not Flags.M64 and then Mode in Mode_Fp then 1391 -- Convert return value from St0 to Xmm0. 1392 declare 1393 Sslot : constant Int32 := -Int32 (Cur_Subprg.Target.Fp_Slot); 1394 begin 1395 -- Move from St0 to Xmm0. 1396 -- fstp slot(%ebp) 1397 Start_Insn; 1398 Init_Modrm_Offset (R_Bp, Sslot, Sz_Fp); 1399 Gen_8 (2#11011_001# + Mode_Fp_To_Mf (Mode)); 1400 Gen_Mod_Rm_Opc (2#00_011_000#); 1401 End_Insn; 1402 -- movsd slot(%ebp), %xmm0 1403 Start_Insn; 1404 Gen_SSE_Prefix (Mode); 1405 Init_Modrm_Offset (R_Bp, Sslot, Sz_Fp); 1406 Gen_SSE_Opc (Opc_Movsd_Xmm_M64); 1407 Gen_Mod_Rm_Opc (2#00_000_000#); 1408 End_Insn; 1409 end; 1410 end if; 1411 end Emit_Call; 1412 1413 procedure Emit_Intrinsic (Stmt : O_Enode) 1414 is 1415 Op : constant Int32 := Get_Intrinsic_Operation (Stmt); 1416 begin 1417 -- Call sym 1418 Gen_Call (Intrinsics_Symbol (Op)); 1419 1420 -- addl esp, val 1421 Emit_Addl_Sp_Imm (16); 1422 end Emit_Intrinsic; 1423 1424 procedure Emit_Setcc (Dest : O_Enode; Cond : O_Reg) is 1425 begin 1426 pragma Assert (Cond in Regs_Cc); 1427 Start_Insn; 1428 Init_Modrm_Expr (Dest, Sz_8); 1429 Gen_8 (Opc_0f); 1430 Gen_8 (Opc2_0f_Setcc + To_Cond (Cond)); 1431 Gen_Mod_Rm_Opc (2#000_000#); 1432 End_Insn; 1433 end Emit_Setcc; 1434 1435 procedure Emit_Setcc_Reg (Reg : O_Reg; Cond : O_Reg) is 1436 begin 1437 pragma Assert (Cond in Regs_Cc); 1438 Start_Insn; 1439 Gen_8 (Opc_0f); 1440 Gen_8 (Opc2_0f_Setcc + To_Cond (Cond)); 1441 Gen_8 (2#11_000_000# + To_Reg32 (Reg, Sz_8)); 1442 End_Insn; 1443 end Emit_Setcc_Reg; 1444 1445 procedure Emit_Tst (Reg : O_Reg; Sz : Insn_Size) is 1446 begin 1447 Start_Insn; 1448 Init_Modrm_Reg (Reg, Sz, Reg, Sz); 1449 Gen_Insn_Sz (Opc_Test_Rm_Reg, Sz); 1450 Gen_Mod_Rm_Reg; 1451 End_Insn; 1452 end Emit_Tst; 1453 1454 procedure Gen_Cmp_Imm (Reg : O_Reg; Val : Int32; Sz : Insn_Size) is 1455 begin 1456 Start_Insn; 1457 Init_Modrm_Reg (Reg, Sz); 1458 Gen_Insn_Grp1 (Opc2_Grp1_Cmp, Val); 1459 End_Insn; 1460 end Gen_Cmp_Imm; 1461 1462 procedure Emit_Spill (Stmt : O_Enode; Sz : Insn_Size) 1463 is 1464 Expr : constant O_Enode := Get_Expr_Operand (Stmt); 1465 Reg : constant O_Reg := Get_Expr_Reg (Expr); 1466 begin 1467 -- A reload is missing. 1468 pragma Assert (Reg /= R_Spill); 1469 Start_Insn; 1470 Init_Modrm_Mem (Stmt, Sz, Reg); 1471 Gen_Insn_Sz (Opc_Mov_Rm_Reg, Sz); 1472 Gen_Mod_Rm_Reg; 1473 End_Insn; 1474 end Emit_Spill; 1475 1476 procedure Emit_Spill_Xmm (Stmt : O_Enode; Mode : Mode_Fp) 1477 is 1478 Expr : constant O_Enode := Get_Expr_Operand (Stmt); 1479 Reg : constant O_Reg := Get_Expr_Reg (Expr); 1480 begin 1481 -- A reload is missing. 1482 pragma Assert (Reg in Regs_Xmm); 1483 -- movsd 1484 Start_Insn; 1485 Gen_SSE_Prefix (Mode); 1486 Init_Modrm_Mem (Stmt, Sz_Fp, Reg); 1487 Gen_SSE_Opc (Opc_Movsd_M64_Xmm); 1488 Gen_Mod_Rm_Reg; 1489 End_Insn; 1490 end Emit_Spill_Xmm; 1491 1492 procedure Emit_Load (Reg : O_Reg; Val : O_Enode; Sz : Insn_Size) 1493 is 1494 begin 1495 Start_Insn; 1496 Init_Modrm_Expr (Val, Sz, Reg); 1497 Gen_Insn_Sz (Opc_Mov_Reg_Rm, Sz); 1498 Gen_Mod_Rm_Reg; 1499 End_Insn; 1500 end Emit_Load; 1501 1502 procedure Emit_Lea (Stmt : O_Enode) 1503 is 1504 Reg : constant O_Reg := Get_Expr_Reg (Stmt); 1505 begin 1506 -- Hack: change the register to use the real address instead of it. 1507 Set_Expr_Reg (Stmt, R_Mem); 1508 1509 Start_Insn; 1510 Init_Modrm_Mem (Stmt, Sz_Ptr, Reg); 1511 Gen_8 (Opc_Leal_Reg_Rm); 1512 Gen_Mod_Rm_Reg; 1513 End_Insn; 1514 1515 -- Restore. 1516 Set_Expr_Reg (Stmt, Reg); 1517 end Emit_Lea; 1518 1519 procedure Gen_Umul (Stmt : O_Enode; Sz : Insn_Size) 1520 is 1521 begin 1522 pragma Assert (Get_Expr_Reg (Get_Expr_Left (Stmt)) = R_Ax); 1523 Start_Insn; 1524 Init_Modrm_Expr (Get_Expr_Right (Stmt), Sz); 1525 Gen_Insn_Sz (Opc_Grp3_Width, Sz); 1526 Gen_Mod_Rm_Opc (Opc2_Grp3_Mul); 1527 End_Insn; 1528 end Gen_Umul; 1529 1530 procedure Gen_Mul (Stmt : O_Enode; Sz : Insn_Size) 1531 is 1532 Reg : constant O_Reg := Get_Expr_Reg (Stmt); 1533 Right : constant O_Enode := Get_Expr_Right (Stmt); 1534 Reg_R : O_Reg; 1535 begin 1536 pragma Assert (Get_Expr_Reg (Get_Expr_Left (Stmt)) = Reg); 1537 Start_Insn; 1538 if Reg = R_Ax then 1539 Init_Modrm_Expr (Right, Sz); 1540 Gen_Insn_Sz (Opc_Grp3_Width, Sz); 1541 Gen_Mod_Rm_Opc (Opc2_Grp3_Mul); 1542 else 1543 Reg_R := Get_Expr_Reg (Right); 1544 case Reg_R is 1545 when R_Imm => 1546 Init_Modrm_Reg (Reg, Sz, Reg, Sz); 1547 if Is_Imm8 (Right, Sz) then 1548 Gen_8 (Opc_Imul_Reg_Rm_Imm8); 1549 Gen_Mod_Rm_Reg; 1550 Gen_Imm8 (Right, Sz); 1551 else 1552 Gen_8 (Opc_Imul_Reg_Rm_Imm32); 1553 Gen_Mod_Rm_Reg; 1554 Gen_Imm (Right, Sz); 1555 end if; 1556 when R_Mem 1557 | R_Spill 1558 | Regs_R64 => 1559 Init_Modrm_Expr (Right, Sz, Reg); 1560 Gen_8 (Opc_0f); 1561 Gen_8 (Opc2_0f_Imul); 1562 Gen_Mod_Rm_Reg; 1563 when others => 1564 Error_Emit ("gen_mul", Stmt); 1565 end case; 1566 end if; 1567 End_Insn; 1568 end Gen_Mul; 1569 1570 -- Do not trap if COND is true. 1571 procedure Gen_Ov_Check (Cond : O_Reg) is 1572 begin 1573 -- JXX +2 1574 Gen_2 (Opc_Jcc + To_Cond (Cond), 16#02#); 1575 -- INT 4 (overflow). 1576 Gen_2 (Opc_Int, 16#04#); 1577 end Gen_Ov_Check; 1578 1579 procedure Gen_Into is 1580 begin 1581 if Flags.M64 then 1582 Gen_Ov_Check (R_No); 1583 else 1584 Gen_1 (Opc_Into); 1585 end if; 1586 end Gen_Into; 1587 1588 procedure Emit_Abs (Val : O_Enode; Mode : Mode_Type) 1589 is 1590 Szl, Szh : Insn_Size; 1591 Pc_Jmp : Pc_Type; 1592 begin 1593 case Mode is 1594 when Mode_I32 => 1595 Szh := Sz_32; 1596 Szl := Sz_32; 1597 when Mode_I64 => 1598 if Flags.M64 then 1599 Szh := Sz_64; 1600 Szl := Sz_64; 1601 else 1602 Szh := Sz_32h; 1603 Szl := Sz_32l; 1604 end if; 1605 when others => 1606 raise Program_Error; 1607 end case; 1608 Emit_Tst (Get_Expr_Reg (Val), Szh); 1609 -- JGE xxx (skip if positive). 1610 Gen_2 (Opc_Jcc + To_Cond (R_Sge), 0); 1611 Pc_Jmp := Get_Current_Pc; 1612 -- NEG 1613 Gen_Grp3_Insn (Opc2_Grp3_Neg, Val, Szl); 1614 if (not Flags.M64) and Mode = Mode_I64 then 1615 -- Propagate carry. 1616 -- Adc reg,0 1617 -- neg reg 1618 Start_Insn; 1619 Init_Modrm_Expr (Val, Sz_32h); 1620 Gen_Insn_Grp1 (Opc2_Grp1_Adc, 0); 1621 End_Insn; 1622 Gen_Grp3_Insn (Opc2_Grp3_Neg, Val, Sz_32h); 1623 end if; 1624 Gen_Into; 1625 Patch_8 (Pc_Jmp - 1, Unsigned_8 (Get_Current_Pc - Pc_Jmp)); 1626 end Emit_Abs; 1627 1628 procedure Gen_Alloca (Stmt : O_Enode) 1629 is 1630 Reg : constant O_Reg := Get_Expr_Reg (Get_Expr_Operand (Stmt)); 1631 begin 1632 pragma Assert (Reg in Regs_R64); 1633 pragma Assert (Reg = Get_Expr_Reg (Stmt)); 1634 -- Align stack on word. 1635 -- Add reg, (stack_boundary - 1) 1636 Start_Insn; 1637 Gen_Rex_B (Reg, Sz_Ptr); 1638 Gen_8 (Opc_Grp1v_Rm_Imm8); 1639 Gen_8 (Opc2_Grp1_Add or 2#11_000_000# or To_Reg32 (Reg)); 1640 Gen_8 (Byte (X86.Flags.Stack_Boundary - 1)); 1641 End_Insn; 1642 -- and reg, ~(stack_boundary - 1) 1643 Start_Insn; 1644 Gen_Rex_B (Reg, Sz_Ptr); 1645 Gen_8 (Opc_Grp1v_Rm_Imm32); 1646 Gen_8 (Opc2_Grp1_And or 2#11_000_000# or To_Reg32 (Reg)); 1647 Gen_32 (not (X86.Flags.Stack_Boundary - 1)); 1648 End_Insn; 1649 if X86.Flags.Flag_Alloca_Call then 1650 Gen_Call (Chkstk_Symbol); 1651 else 1652 -- subl esp, reg 1653 Start_Insn; 1654 Gen_Rex_B (Reg, Sz_Ptr); 1655 Gen_8 (Opc_Subl_Reg_Rm); 1656 Gen_8 (2#11_100_000# + To_Reg32 (Reg)); 1657 End_Insn; 1658 end if; 1659 -- movl reg, esp 1660 Start_Insn; 1661 Gen_Rex_B (Reg, Sz_Ptr); 1662 Gen_8 (Opc_Mov_Rm_Reg + 1); 1663 Gen_8 (2#11_100_000# + To_Reg32 (Reg)); 1664 End_Insn; 1665 end Gen_Alloca; 1666 1667 -- Byte/word to long. 1668 procedure Gen_Movzx (Reg : Regs_R64; Op : O_Enode; Dst_Sz : Insn_Size) is 1669 begin 1670 Start_Insn; 1671 Init_Modrm_Expr (Op, Dst_Sz, Reg); 1672 Gen_8 (Opc_0f); 1673 case Get_Expr_Mode (Op) is 1674 when Mode_I8 | Mode_U8 | Mode_B2 => 1675 Gen_8 (Opc2_0f_Movzx); 1676 when Mode_I16 | Mode_U16 => 1677 Gen_8 (Opc2_0f_Movzx + 1); 1678 when others => 1679 raise Program_Error; 1680 end case; 1681 Gen_Mod_Rm_Reg; 1682 End_Insn; 1683 end Gen_Movzx; 1684 1685 procedure Gen_Movsxd (Src : O_Reg; Dst : O_Reg) is 1686 begin 1687 Start_Insn; 1688 Init_Modrm_Reg (Src, Sz_64, Dst, Sz_64); 1689 Gen_8 (Opc_Movsxd_Reg_Rm); 1690 Gen_Mod_Rm_Reg; 1691 End_Insn; 1692 end Gen_Movsxd; 1693 1694 procedure Emit_Move (Operand : O_Enode; Sz : Insn_Size; Reg : O_Reg) is 1695 begin 1696 -- mov REG, OP 1697 Start_Insn; 1698 Init_Modrm_Expr (Operand, Sz, Reg); 1699 Gen_Insn_Sz (Opc_Mov_Reg_Rm, Sz); 1700 Gen_Mod_Rm_Reg; 1701 End_Insn; 1702 end Emit_Move; 1703 1704 procedure Emit_Move_Xmm (Operand : O_Enode; Mode : Mode_Fp; Reg : O_Reg) is 1705 begin 1706 -- movsd REG, OP 1707 Start_Insn; 1708 Gen_SSE_Prefix (Mode); 1709 Init_Modrm_Expr (Operand, Sz_Fp, Reg); 1710 Gen_SSE_Opc (Opc_Movsd_Xmm_M64); 1711 Gen_Mod_Rm_Reg; 1712 End_Insn; 1713 end Emit_Move_Xmm; 1714 1715 -- Convert U32 to xx. 1716 procedure Gen_Conv_U32 (Stmt : O_Enode; Ov : Boolean) 1717 is 1718 Op : constant O_Enode := Get_Expr_Operand (Stmt); 1719 Reg_Op : constant O_Reg := Get_Expr_Reg (Op); 1720 Reg_Res : constant O_Reg := Get_Expr_Reg (Stmt); 1721 begin 1722 case Get_Expr_Mode (Stmt) is 1723 when Mode_I32 => 1724 pragma Assert (Reg_Res in Regs_R32); 1725 if Reg_Op /= Reg_Res then 1726 Emit_Load (Reg_Res, Op, Sz_32); 1727 end if; 1728 if Ov then 1729 Emit_Tst (Reg_Res, Sz_32); 1730 Gen_Ov_Check (R_Sge); 1731 end if; 1732 when Mode_I64 => 1733 if Flags.M64 then 1734 Emit_Move (Op, Sz_32, Reg_Res); 1735 else 1736 pragma Assert (Reg_Res = R_Edx_Eax); 1737 pragma Assert (Reg_Op = R_Ax); 1738 -- Clear edx. 1739 Gen_Clear_Edx; 1740 end if; 1741 when Mode_U8 1742 | Mode_B2 => 1743 pragma Assert (Reg_Res in Regs_R32); 1744 if Reg_Op /= Reg_Res then 1745 Emit_Load (Reg_Res, Op, Sz_32); 1746 end if; 1747 if Ov then 1748 -- cmpl VAL, 0xff 1749 Start_Insn; 1750 Init_Modrm_Expr (Op, Sz_32); 1751 Gen_8 (Opc_Grp1v_Rm_Imm32); 1752 Gen_Mod_Rm_Opc (Opc2_Grp1_Cmp); 1753 Gen_32 (16#00_00_00_Ff#); 1754 End_Insn; 1755 Gen_Ov_Check (R_Ule); 1756 end if; 1757 when others => 1758 Error_Emit ("gen_conv_u32", Stmt); 1759 end case; 1760 end Gen_Conv_U32; 1761 1762 -- Convert I32 to xxx 1763 procedure Gen_Conv_I32 (Stmt : O_Enode; Ov : Boolean) 1764 is 1765 Op : constant O_Enode := Get_Expr_Operand (Stmt); 1766 Reg_Op : constant O_Reg := Get_Expr_Reg (Op); 1767 Reg_Res : constant O_Reg := Get_Expr_Reg (Stmt); 1768 begin 1769 case Get_Expr_Mode (Stmt) is 1770 when Mode_I64 => 1771 if Flags.M64 then 1772 Gen_Movsxd (Reg_Op, Reg_Res); 1773 else 1774 pragma Assert (Reg_Res = R_Edx_Eax); 1775 pragma Assert (Reg_Op = R_Ax); 1776 Gen_Cdq (Sz_32); 1777 end if; 1778 when Mode_U32 => 1779 pragma Assert (Reg_Res in Regs_R32); 1780 if Reg_Op /= Reg_Res then 1781 Emit_Load (Reg_Res, Op, Sz_32); 1782 end if; 1783 if Ov then 1784 Emit_Tst (Reg_Res, Sz_32); 1785 Gen_Ov_Check (R_Sge); 1786 end if; 1787 when Mode_B2 => 1788 if Reg_Op /= Reg_Res then 1789 Emit_Load (Reg_Res, Op, Sz_32); 1790 end if; 1791 if Ov then 1792 Gen_Cmp_Imm (Reg_Res, 1, Sz_32); 1793 Gen_Ov_Check (R_Ule); 1794 end if; 1795 when Mode_U8 => 1796 if Reg_Op /= Reg_Res then 1797 Emit_Load (Reg_Res, Op, Sz_32); 1798 end if; 1799 if Ov then 1800 Gen_Cmp_Imm (Reg_Res, 16#Ff#, Sz_32); 1801 Gen_Ov_Check (R_Ule); 1802 end if; 1803 when Mode_F64 => 1804 if Reg_Res in Regs_Xmm then 1805 -- cvtsi2sd 1806 Gen_SSE_Prefix (Mode_F64); 1807 Init_Modrm_Expr (Op, Sz_32, Reg_Res); 1808 Gen_SSE_Opc (Opc_Cvtsi2sd_Xmm_Rm); 1809 Gen_Mod_Rm_Reg; 1810 End_Insn; 1811 else 1812 Emit_Push (Op, Sz_32); 1813 -- fild (%esp) 1814 Start_Insn; 1815 Gen_8 (2#11011_011#); 1816 Gen_8 (2#00_000_100#); 1817 Gen_8 (2#00_100_100#); 1818 End_Insn; 1819 -- addl %esp, 4 1820 Emit_Addl_Sp_Imm (4); 1821 end if; 1822 when others => 1823 Error_Emit ("gen_conv_i32", Stmt); 1824 end case; 1825 end Gen_Conv_I32; 1826 1827 -- Convert U8 to xxx 1828 procedure Gen_Conv_U8 (Stmt : O_Enode) 1829 is 1830 Mode : constant Mode_Type := Get_Expr_Mode (Stmt); 1831 Op : constant O_Enode := Get_Expr_Operand (Stmt); 1832 Reg_Res : constant O_Reg := Get_Expr_Reg (Stmt); 1833 Reg_Op : constant O_Reg := Get_Expr_Reg (Op); 1834 begin 1835 case Mode is 1836 when Mode_U32 1837 | Mode_I32 1838 | Mode_U16 1839 | Mode_I16 => 1840 pragma Assert (Reg_Res in Regs_R64); 1841 Gen_Movzx (Reg_Res, Op, Int_Mode_To_Size (Mode)); 1842 when Mode_I64 1843 | Mode_U64 => 1844 if Flags.M64 then 1845 Gen_Movzx (Reg_Res, Op, Sz_64); 1846 else 1847 pragma Assert (Reg_Res = R_Edx_Eax); 1848 pragma Assert (Reg_Op = R_Ax); 1849 Gen_Movzx (R_Ax, Op, Sz_32); 1850 -- Sign-extend, but we know the sign is positive. 1851 Gen_Cdq (Sz_32); 1852 end if; 1853 when others => 1854 Error_Emit ("gen_conv_U8", Stmt); 1855 end case; 1856 end Gen_Conv_U8; 1857 1858 -- Convert B2 to xxx 1859 procedure Gen_Conv_B2 (Stmt : O_Enode) 1860 is 1861 Mode : constant Mode_Type := Get_Expr_Mode (Stmt); 1862 Op : constant O_Enode := Get_Expr_Operand (Stmt); 1863 Reg_Op : constant O_Reg := Get_Expr_Reg (Op); 1864 Reg_Res : constant O_Reg := Get_Expr_Reg (Stmt); 1865 begin 1866 case Mode is 1867 when Mode_U32 1868 | Mode_I32 1869 | Mode_U16 1870 | Mode_I16 => 1871 pragma Assert (Reg_Res in Regs_R64); 1872 Gen_Movzx (Reg_Res, Op, Int_Mode_To_Size (Mode)); 1873 when Mode_I64 => 1874 if Flags.M64 then 1875 Gen_Movzx (Reg_Res, Op, Sz_64); 1876 else 1877 pragma Assert (Reg_Res = R_Edx_Eax); 1878 pragma Assert (Reg_Op = R_Ax); 1879 Gen_Movzx (R_Ax, Op, Sz_32); 1880 -- Sign-extend, but we know the sign is positive. 1881 Gen_Cdq (Sz_32); 1882 end if; 1883 when others => 1884 Error_Emit ("gen_conv_B2", Stmt); 1885 end case; 1886 end Gen_Conv_B2; 1887 1888 -- Convert I64 to xxx 1889 procedure Gen_Conv_I64 (Stmt : O_Enode; Ov : Boolean) 1890 is 1891 Mode : constant Mode_Type := Get_Expr_Mode (Stmt); 1892 Op : constant O_Enode := Get_Expr_Operand (Stmt); 1893 Reg_Op : constant O_Reg := Get_Expr_Reg (Op); 1894 Reg_Res : constant O_Reg := Get_Expr_Reg (Stmt); 1895 begin 1896 case Mode is 1897 when Mode_I32 => 1898 if Flags.M64 then 1899 -- movsxd src, dst 1900 Gen_Movsxd (Reg_Op, Reg_Res); 1901 if Ov then 1902 -- cmp src,dst 1903 Start_Insn; 1904 Init_Modrm_Reg (Reg_Op, Sz_64, Reg_Res, Sz_64); 1905 Gen_8 (Opc_Cmpl_Rm_Reg); 1906 Gen_Mod_Rm_Reg; 1907 End_Insn; 1908 -- Overflow if extended value is different from initial one. 1909 Gen_Ov_Check (R_Eq); 1910 end if; 1911 else 1912 pragma Assert (Reg_Op = R_Edx_Eax); 1913 pragma Assert (Reg_Res = R_Ax); 1914 -- move dx to reg_helper 1915 Start_Insn; 1916 Gen_8 (Opc_Mov_Rm_Reg + 1); 1917 Gen_8 (2#11_010_000# + To_Reg32 (Reg_Helper)); 1918 End_Insn; 1919 -- Sign extend eax. 1920 Gen_Cdq (Sz_32); 1921 if Ov then 1922 -- cmp reg_helper, dx 1923 Start_Insn; 1924 Gen_8 (Opc_Cmpl_Rm_Reg); 1925 Gen_8 (2#11_010_000# + To_Reg32 (Reg_Helper)); 1926 End_Insn; 1927 -- Overflow if extended value is different from initial one. 1928 Gen_Ov_Check (R_Eq); 1929 end if; 1930 end if; 1931 when Mode_U8 1932 | Mode_B2 => 1933 declare 1934 Ubound : Int32; 1935 begin 1936 if Mode = Mode_B2 then 1937 Ubound := 1; 1938 else 1939 Ubound := 16#ff#; 1940 end if; 1941 1942 if Flags.M64 then 1943 Emit_Load (Reg_Res, Op, Sz_64); 1944 if Ov then 1945 Start_Insn; 1946 Init_Modrm_Reg (Reg_Res, Sz_64); 1947 Gen_Insn_Grp1 (Opc2_Grp1_Cmp, Ubound); 1948 End_Insn; 1949 Gen_Ov_Check (R_Ule); 1950 end if; 1951 else 1952 pragma Assert (Reg_Op in Regs_Pair); 1953 if Ov then 1954 -- Check MSB = 0 1955 Emit_Tst (Reg_Op, Sz_32h); 1956 Gen_Ov_Check (R_Eq); 1957 end if; 1958 -- Check LSB <= 255 (U8) or LSB <= 1 (B2) 1959 if Reg_Op /= Reg_Res then 1960 -- Move reg_op -> reg_res 1961 -- FIXME: factorize with OE_Mov. 1962 Start_Insn; 1963 Init_Modrm_Reg (Reg_Op, Sz_32l, Reg_Res); 1964 Gen_Insn_Sz (Opc_Mov_Reg_Rm, Sz_32); 1965 Gen_Mod_Rm_Reg; 1966 End_Insn; 1967 end if; 1968 if Ov then 1969 Gen_Cmp_Imm (Reg_Res, Ubound, Sz_32); 1970 Gen_Ov_Check (R_Ule); 1971 end if; 1972 end if; 1973 end; 1974 when Mode_F64 => 1975 if Flags.M64 then 1976 -- cvtsi2sd 1977 Gen_SSE_Prefix (Mode_F64); 1978 Init_Modrm_Expr (Op, Sz_64, Reg_Res); 1979 Gen_SSE_Opc (Opc_Cvtsi2sd_Xmm_Rm); 1980 Gen_Mod_Rm_Reg; 1981 End_Insn; 1982 else 1983 Emit_Push (Op, Sz_32h); 1984 Emit_Push (Op, Sz_32l); 1985 -- fild (%esp) 1986 Start_Insn; 1987 Gen_8 (2#11011_111#); 1988 Gen_8 (2#00_101_100#); 1989 Gen_8 (2#00_100_100#); 1990 End_Insn; 1991 if Reg_Res in Regs_Xmm then 1992 -- fstp (%esp) 1993 Start_Insn; 1994 Gen_8 (2#11011_00_1# + Mode_Fp_To_Mf (Mode_F64)); 1995 Gen_8 (2#00_011_100#); 1996 Gen_8 (2#00_100_100#); 1997 End_Insn; 1998 -- movsd (%esp), %xmm 1999 Start_Insn; 2000 Gen_SSE_Prefix (Mode_F64); 2001 Gen_SSE_Opc (Opc_Movsd_Xmm_M64); 2002 Gen_8 (To_Reg_Xmm (Reg_Res) * 8 + 2#00_000_100#); 2003 Gen_8 (2#00_100_100#); 2004 End_Insn; 2005 end if; 2006 -- addl %esp, 8 2007 Emit_Addl_Sp_Imm (8); 2008 end if; 2009 when others => 2010 Error_Emit ("gen_conv_I64", Stmt); 2011 end case; 2012 end Gen_Conv_I64; 2013 2014 -- Convert FP to xxx. 2015 procedure Gen_Conv_Fp (Stmt : O_Enode) 2016 is 2017 Mode : constant Mode_Type := Get_Expr_Mode (Stmt); 2018 Reg : constant O_Reg := Get_Expr_Reg (Stmt); 2019 Reg_Op : constant O_Reg := Get_Expr_Reg (Get_Expr_Operand (Stmt)); 2020 Sslot : constant Int32 := -Int32 (Cur_Subprg.Target.Fp_Slot); 2021 begin 2022 if Abi.Flag_Sse2 and then 2023 (Mode = Mode_I32 or (Flags.M64 and Mode = Mode_I64)) 2024 then 2025 -- cvtsd2si 2026 Gen_SSE_Prefix (Mode_F64); 2027 Init_Modrm_Reg (Reg_Op, Int_Mode_To_Size (Mode), Reg); 2028 Gen_SSE_Opc (Opc_Cvtsd2si_Reg_Xm); 2029 Gen_Mod_Rm_Reg; 2030 End_Insn; 2031 return; 2032 end if; 2033 2034 if Reg_Op in Regs_Xmm then 2035 -- movsd %xmm, (%ebp), 2036 Start_Insn; 2037 Gen_SSE_Prefix (Mode_F64); 2038 Init_Modrm_Offset (R_Bp, Sslot, Sz_Ptr, Reg_Op); 2039 Gen_SSE_Opc (Opc_Movsd_M64_Xmm); 2040 Gen_Mod_Rm_Reg; 2041 End_Insn; 2042 -- fldl slot(%ebp) 2043 Start_Insn; 2044 Init_Modrm_Offset (R_Bp, Sslot, Sz_Ptr); 2045 Gen_8 (2#11011_00_1# + Mode_Fp_To_Mf (Mode_F64)); 2046 Gen_Mod_Rm_Opc (2#00_000_000#); 2047 End_Insn; 2048 end if; 2049 2050 case Mode is 2051 when Mode_I32 => 2052 -- fistpl slot(%ebp) 2053 Start_Insn; 2054 Init_Modrm_Offset (R_Bp, Sslot, Sz_32); 2055 Gen_8 (2#11011_011#); 2056 Gen_Mod_Rm_Opc (2#00_011_000#); 2057 End_Insn; 2058 -- movl slot(%ebp), reg 2059 Start_Insn; 2060 Init_Modrm_Offset (R_Bp, Sslot, Sz_32, Reg); 2061 Gen_8 (Opc_Movl_Reg_Rm); 2062 Gen_Mod_Rm_Reg; 2063 End_Insn; 2064 when Mode_I64 => 2065 -- fistpq slot(%ebp) 2066 Start_Insn; 2067 Init_Modrm_Offset (R_Bp, Sslot, Sz_32); 2068 Gen_8 (2#11011_111#); 2069 Gen_Mod_Rm_Opc (2#00_111_000#); 2070 End_Insn; 2071 -- movl slot(%ebp), reg 2072 for Sz in Sz_32l .. Sz_32h loop 2073 Start_Insn; 2074 Init_Modrm_Offset (R_Bp, Sslot, Sz, Reg); 2075 Gen_8 (Opc_Movl_Reg_Rm); 2076 Gen_Mod_Rm_Reg; 2077 End_Insn; 2078 end loop; 2079 when others => 2080 Error_Emit ("gen_conv_fp", Stmt); 2081 end case; 2082 end Gen_Conv_Fp; 2083 2084 procedure Gen_Grp1_Insn_Mode (Stmt : O_Enode; Cl : Byte; Ch : Byte) is 2085 begin 2086 case Get_Expr_Mode (Stmt) is 2087 when Mode_U32 2088 | Mode_I32 2089 | Mode_P32 => 2090 Gen_Grp1_Insn (Cl, Stmt, Sz_32); 2091 when Mode_I64 2092 | Mode_U64 => 2093 if Flags.M64 then 2094 Gen_Grp1_Insn (Cl, Stmt, Sz_64); 2095 else 2096 Gen_Grp1_Insn (Cl, Stmt, Sz_32l); 2097 Gen_Grp1_Insn (Ch, Stmt, Sz_32h); 2098 end if; 2099 when Mode_B2 2100 | Mode_I8 2101 | Mode_U8 => 2102 Gen_Grp1_Insn (Cl, Stmt, Sz_8); 2103 when others => 2104 Error_Emit ("gen_grp1_insn_mode", Stmt); 2105 end case; 2106 end Gen_Grp1_Insn_Mode; 2107 2108 procedure Gen_Check_Overflow (Mode : Mode_Type) is 2109 begin 2110 case Mode is 2111 when Mode_I32 2112 | Mode_I64 2113 | Mode_I8 => 2114 Gen_Into; 2115 when Mode_U64 2116 | Mode_U32 2117 | Mode_U8 => 2118 -- FIXME: check no carry. 2119 null; 2120 when Mode_B2 => 2121 null; 2122 when others => 2123 raise Program_Error; 2124 end case; 2125 end Gen_Check_Overflow; 2126 2127 procedure Gen_Emit_Fp_Op (Stmt : O_Enode; Fp_Op : Byte) 2128 is 2129 Right : constant O_Enode := Get_Expr_Right (Stmt); 2130 Reg : constant O_Reg := Get_Expr_Reg (Right); 2131 B_Size : Byte; 2132 begin 2133 Start_Insn; 2134 case Reg is 2135 when R_St0 => 2136 Gen_8 (2#11011_110#); 2137 Gen_8 (2#11_000_001# or Fp_Op); 2138 when R_Mem => 2139 case Get_Expr_Mode (Stmt) is 2140 when Mode_F32 => 2141 B_Size := 0; 2142 when Mode_F64 => 2143 B_Size := 2#100#; 2144 when others => 2145 raise Program_Error; 2146 end case; 2147 Init_Modrm_Mem (Right, Sz_Ptr); 2148 Gen_8 (2#11011_000# or B_Size); 2149 Gen_Mod_Rm_Opc (Fp_Op); 2150 when others => 2151 raise Program_Error; 2152 end case; 2153 End_Insn; 2154 end Gen_Emit_Fp_Op; 2155 2156 procedure Gen_Emit_Fp_Or_Xmm_Op 2157 (Stmt : O_Enode; Fp_Op : Byte; Xmm_Op : Byte) 2158 is 2159 Reg : constant O_Reg := Get_Expr_Reg (Stmt); 2160 begin 2161 if Reg in Regs_Xmm then 2162 declare 2163 Mode : constant Mode_Type := Get_Expr_Mode (Stmt); 2164 Right : constant O_Enode := Get_Expr_Right (Stmt); 2165 begin 2166 Start_Insn; 2167 Gen_SSE_Prefix (Mode); 2168 Init_Modrm_Expr (Right, Sz_32, Reg); 2169 Gen_SSE_Opc (Xmm_Op); 2170 Gen_Mod_Rm_Reg; 2171 End_Insn; 2172 end; 2173 else 2174 Gen_Emit_Fp_Op (Stmt, Fp_Op); 2175 end if; 2176 end Gen_Emit_Fp_Or_Xmm_Op; 2177 2178 procedure Emit_Mod (Stmt : O_Enode; Sz : Insn_Size) 2179 is 2180 Right : O_Enode; 2181 Pc1, Pc2, Pc3: Pc_Type; 2182 begin 2183 -- a : EAX 2184 -- d : EDX 2185 -- b : Rm 2186 2187 -- d := Rm 2188 -- d := d ^ a 2189 -- cltd 2190 -- if cc < 0 then 2191 -- idiv b 2192 -- if edx /= 0 then 2193 -- edx := edx + b 2194 -- end if 2195 -- else 2196 -- idiv b 2197 -- end if 2198 Right := Get_Expr_Right (Stmt); 2199 -- %edx <- right 2200 Emit_Load (R_Dx, Right, Sz); 2201 -- xorl %eax -> %edx 2202 Start_Insn; 2203 Gen_Rex_B (R_None, Sz); 2204 Gen_8 (Opc_Xorl_Rm_Reg); 2205 Gen_8 (2#11_000_010#); 2206 End_Insn; 2207 Gen_Cdq (Sz); 2208 -- js 2209 Gen_2 (Opc_Jcc + 2#1000#, 0); 2210 Pc1 := Get_Current_Pc; 2211 -- idiv 2212 Gen_Grp3_Insn (Opc2_Grp3_Idiv, Right, Sz); 2213 -- jmp 2214 Gen_2 (Opc_Jmp_Short, 0); 2215 Pc2 := Get_Current_Pc; 2216 Patch_8 (Pc1 - 1, Unsigned_8 (Get_Current_Pc - Pc1)); 2217 -- idiv 2218 Gen_Grp3_Insn (Opc2_Grp3_Idiv, Right, Sz); 2219 -- tstl %edx,%edx 2220 Start_Insn; 2221 Gen_Rex_B (R_None, Sz); 2222 Gen_8 (Opc_Test_Rm_Reg + 1); 2223 Gen_8 (2#11_010_010#); 2224 End_Insn; 2225 -- jz 2226 Gen_2 (Opc_Jcc + 2#0100#, 0); 2227 Pc3 := Get_Current_Pc; 2228 -- addl b, %edx 2229 Start_Insn; 2230 Init_Modrm_Expr (Right, Sz, R_Dx); 2231 Gen_8 (Opc_Addl_Reg_Rm); 2232 Gen_Mod_Rm_Reg; 2233 End_Insn; 2234 Patch_8 (Pc2 - 1, Unsigned_8 (Get_Current_Pc - Pc2)); 2235 Patch_8 (Pc3 - 1, Unsigned_8 (Get_Current_Pc - Pc3)); 2236 end Emit_Mod; 2237 2238 procedure Emit_Insn (Stmt : O_Enode) 2239 is 2240 use Ortho_Code.Flags; 2241 Kind : constant OE_Kind := Get_Expr_Kind (Stmt); 2242 Mode : constant Mode_Type := Get_Expr_Mode (Stmt); 2243 Reg : O_Reg; 2244 begin 2245 case Kind is 2246 when OE_Beg => 2247 if Flag_Debug /= Debug_None then 2248 Decls.Set_Block_Info1 (Get_Block_Decls (Stmt), 2249 Int32 (Get_Current_Pc - Subprg_Pc)); 2250 end if; 2251 when OE_End => 2252 if Flag_Debug /= Debug_None then 2253 Decls.Set_Block_Info2 (Get_Block_Decls (Get_End_Beg (Stmt)), 2254 Int32 (Get_Current_Pc - Subprg_Pc)); 2255 end if; 2256 when OE_Leave => 2257 null; 2258 when OE_BB => 2259 null; 2260 when OE_Add_Ov => 2261 if Mode in Mode_Fp then 2262 Gen_Emit_Fp_Or_Xmm_Op (Stmt, 2#000_000#, 16#58#); 2263 else 2264 Gen_Grp1_Insn_Mode (Stmt, Opc2_Grp1_Add, Opc2_Grp1_Adc); 2265 Gen_Check_Overflow (Mode); 2266 end if; 2267 when OE_Or => 2268 Gen_Grp1_Insn_Mode (Stmt, Opc2_Grp1_Or, Opc2_Grp1_Or); 2269 when OE_And => 2270 Gen_Grp1_Insn_Mode (Stmt, Opc2_Grp1_And, Opc2_Grp1_And); 2271 when OE_Xor => 2272 Gen_Grp1_Insn_Mode (Stmt, Opc2_Grp1_Xor, Opc2_Grp1_Xor); 2273 when OE_Sub_Ov => 2274 if Mode in Mode_Fp then 2275 Gen_Emit_Fp_Or_Xmm_Op (Stmt, 2#100_000#, 16#5c#); 2276 else 2277 Gen_Grp1_Insn_Mode (Stmt, Opc2_Grp1_Sub, Opc2_Grp1_Sbb); 2278 Gen_Check_Overflow (Mode); 2279 end if; 2280 when OE_Mul_Ov 2281 | OE_Mul => 2282 case Mode is 2283 when Mode_U8 => 2284 Gen_Umul (Stmt, Sz_8); 2285 when Mode_U16 => 2286 Gen_Umul (Stmt, Sz_16); 2287 when Mode_U32 => 2288 Gen_Mul (Stmt, Sz_32); 2289 when Mode_I32 => 2290 Gen_Grp3_Insn (Opc2_Grp3_Imul, Get_Expr_Right (Stmt), Sz_32); 2291 if Kind = OE_Mul_Ov then 2292 Gen_Check_Overflow (Mode); 2293 end if; 2294 when Mode_I64 => 2295 Gen_Grp3_Insn (Opc2_Grp3_Imul, Get_Expr_Right (Stmt), Sz_64); 2296 if Kind = OE_Mul_Ov then 2297 Gen_Check_Overflow (Mode); 2298 end if; 2299 when Mode_U64 => 2300 pragma Assert (Flags.M64); 2301 Gen_Mul (Stmt, Sz_64); 2302 when Mode_F32 2303 | Mode_F64 => 2304 Gen_Emit_Fp_Or_Xmm_Op (Stmt, 2#001_000#, 16#59#); 2305 when others => 2306 Error_Emit ("emit_insn: mul_ov", Stmt); 2307 end case; 2308 when OE_Shl => 2309 declare 2310 Right : O_Enode; 2311 Sz : Insn_Size; 2312 Val : Uns32; 2313 begin 2314 case Mode is 2315 when Mode_U32 => 2316 Sz := Sz_32; 2317 when others => 2318 Error_Emit ("emit_insn: shl", Stmt); 2319 end case; 2320 Right := Get_Expr_Right (Stmt); 2321 if Get_Expr_Kind (Right) = OE_Const then 2322 Val := Get_Expr_Low (Right); 2323 Start_Insn; 2324 Init_Modrm_Expr (Get_Expr_Left (Stmt), Sz); 2325 if Val = 1 then 2326 Gen_Insn_Sz (2#1101000_0#, Sz); 2327 Gen_Mod_Rm_Opc (2#100_000#); 2328 else 2329 Gen_Insn_Sz (2#1100000_0#, Sz); 2330 Gen_Mod_Rm_Opc (2#100_000#); 2331 Gen_8 (Byte (Val and 31)); 2332 end if; 2333 End_Insn; 2334 else 2335 pragma Assert (Get_Expr_Reg (Right) = R_Cx); 2336 Start_Insn; 2337 Init_Modrm_Expr (Get_Expr_Left (Stmt), Sz); 2338 Gen_Insn_Sz (2#1101001_0#, Sz); 2339 Gen_Mod_Rm_Opc (2#100_000#); 2340 End_Insn; 2341 end if; 2342 end; 2343 when OE_Mod 2344 | OE_Rem 2345 | OE_Div_Ov => 2346 case Mode is 2347 when Mode_U32 2348 | Mode_U64 => 2349 Gen_Clear_Edx; 2350 Gen_Grp3_Insn (Opc2_Grp3_Div, Get_Expr_Right (Stmt), 2351 Int_Mode_To_Size (Mode)); 2352 when Mode_I32 2353 | Mode_I64 => 2354 declare 2355 Sz : constant Insn_Size := Int_Mode_To_Size (Mode); 2356 begin 2357 if Kind = OE_Mod then 2358 Emit_Mod (Stmt, Sz); 2359 else 2360 Gen_Cdq (Sz); 2361 Gen_Grp3_Insn 2362 (Opc2_Grp3_Idiv, Get_Expr_Right (Stmt), Sz); 2363 end if; 2364 end; 2365 when Mode_F32 2366 | Mode_F64 => 2367 -- No Mod or Rem for fp types. 2368 pragma Assert (Kind = OE_Div_Ov); 2369 Gen_Emit_Fp_Or_Xmm_Op (Stmt, 2#110_000#, 16#5e#); 2370 when others => 2371 Error_Emit ("emit_insn: mod_ov", Stmt); 2372 end case; 2373 2374 when OE_Not => 2375 case Mode is 2376 when Mode_B2 => 2377 -- Xor VAL, $1 2378 Start_Insn; 2379 Init_Modrm_Expr (Stmt, Sz_8); 2380 Gen_8 (Opc_Grp1v_Rm_Imm8); 2381 Gen_Mod_Rm_Opc (Opc2_Grp1_Xor); 2382 Gen_8 (16#01#); 2383 End_Insn; 2384 when Mode_U8 => 2385 Gen_Grp3_Insn_Stmt (Opc2_Grp3_Not, Stmt, Sz_8); 2386 when Mode_U16 => 2387 Gen_Grp3_Insn_Stmt (Opc2_Grp3_Not, Stmt, Sz_16); 2388 when Mode_U32 => 2389 Gen_Grp3_Insn_Stmt (Opc2_Grp3_Not, Stmt, Sz_32); 2390 when Mode_U64 => 2391 if Flags.M64 then 2392 Gen_Grp3_Insn_Stmt (Opc2_Grp3_Not, Stmt, Sz_64); 2393 else 2394 Gen_Grp3_Insn_Stmt (Opc2_Grp3_Not, Stmt, Sz_32l); 2395 Gen_Grp3_Insn_Stmt (Opc2_Grp3_Not, Stmt, Sz_32h); 2396 end if; 2397 when others => 2398 Error_Emit ("emit_insn: not", Stmt); 2399 end case; 2400 2401 when OE_Neg_Ov => 2402 case Mode is 2403 when Mode_I8 => 2404 Gen_Grp3_Insn_Stmt (Opc2_Grp3_Neg, Stmt, Sz_8); 2405 --Gen_Into; 2406 when Mode_I16 => 2407 Gen_Grp3_Insn_Stmt (Opc2_Grp3_Neg, Stmt, Sz_16); 2408 --Gen_Into; 2409 when Mode_I32 => 2410 Gen_Grp3_Insn_Stmt (Opc2_Grp3_Neg, Stmt, Sz_32); 2411 --Gen_Into; 2412 when Mode_I64 => 2413 if Flags.M64 then 2414 Gen_Grp3_Insn_Stmt (Opc2_Grp3_Neg, Stmt, Sz_64); 2415 else 2416 Gen_Grp3_Insn_Stmt (Opc2_Grp3_Neg, Stmt, Sz_32l); 2417 -- adcl 0, high 2418 Start_Insn; 2419 Init_Modrm_Expr (Get_Expr_Operand (Stmt), Sz_32h); 2420 Gen_8 (Opc_Grp1v_Rm_Imm8); 2421 Gen_Mod_Rm_Opc (Opc2_Grp1_Adc); 2422 Gen_8 (0); 2423 End_Insn; 2424 Gen_Grp3_Insn_Stmt (Opc2_Grp3_Neg, Stmt, Sz_32h); 2425 --Gen_Into; 2426 end if; 2427 when Mode_F32 2428 | Mode_F64 => 2429 Reg := Get_Expr_Reg (Stmt); 2430 if Reg in Regs_Xmm then 2431 -- Xorp{sd} reg, cst 2432 Start_Insn; 2433 Init_Modrm_Sym (Get_Xmm_Sign_Constant (Mode), Sz_32, Reg); 2434 Gen_SSE_D16_Opc (Mode, Opc2_0f_Xorp); 2435 Gen_Mod_Rm_Reg; 2436 End_Insn; 2437 else 2438 -- fchs 2439 Gen_2 (2#11011_001#, 2#1110_0000#); 2440 end if; 2441 when others => 2442 Error_Emit ("emit_insn: neg_ov", Stmt); 2443 end case; 2444 2445 when OE_Abs_Ov => 2446 case Mode is 2447 when Mode_I32 2448 | Mode_I64 => 2449 Emit_Abs (Get_Expr_Operand (Stmt), Mode); 2450 when Mode_F32 2451 | Mode_F64 => 2452 Reg := Get_Expr_Reg (Stmt); 2453 if Reg in Regs_Xmm then 2454 -- Andp{sd} reg, cst 2455 Start_Insn; 2456 Init_Modrm_Sym (Get_Xmm_Mask_Constant (Mode), Sz_32, Reg); 2457 Gen_SSE_D16_Opc (Mode, Opc2_0f_Andp); 2458 Gen_Mod_Rm_Reg; 2459 End_Insn; 2460 else 2461 -- fabs 2462 Gen_2 (2#11011_001#, 2#1110_0001#); 2463 end if; 2464 when others => 2465 Error_Emit ("emit_insn: abs_ov", Stmt); 2466 end case; 2467 2468 when OE_Kind_Cmp => 2469 declare 2470 Left : constant O_Enode := Get_Expr_Left (Stmt); 2471 Op_Mode : constant Mode_Type := Get_Expr_Mode (Left); 2472 begin 2473 case Op_Mode is 2474 when Mode_U32 2475 | Mode_I32 2476 | Mode_P32 => 2477 Gen_Grp1_Insn (Opc2_Grp1_Cmp, Stmt, Sz_32); 2478 when Mode_B2 2479 | Mode_I8 2480 | Mode_U8 => 2481 Gen_Grp1_Insn (Opc2_Grp1_Cmp, Stmt, Sz_8); 2482 when Mode_U64 2483 | Mode_P64 => 2484 if Flags.M64 then 2485 Gen_Grp1_Insn (Opc2_Grp1_Cmp, Stmt, Sz_64); 2486 else 2487 declare 2488 Pc : Pc_Type; 2489 begin 2490 Gen_Grp1_Insn (Opc2_Grp1_Cmp, Stmt, Sz_32h); 2491 -- jne 2492 Gen_2 (Opc_Jcc + 2#0101#, 0); 2493 Pc := Get_Current_Pc; 2494 Gen_Grp1_Insn (Opc2_Grp1_Cmp, Stmt, Sz_32l); 2495 Patch_8 (Pc - 1, Unsigned_8 (Get_Current_Pc - Pc)); 2496 end; 2497 end if; 2498 when Mode_I64 => 2499 if Flags.M64 then 2500 Gen_Grp1_Insn (Opc2_Grp1_Cmp, Stmt, Sz_64); 2501 else 2502 declare 2503 Pc : Pc_Type; 2504 begin 2505 Reg := Get_Expr_Reg (Stmt); 2506 Gen_Grp1_Insn (Opc2_Grp1_Cmp, Stmt, Sz_32h); 2507 -- Note: this does not clobber a reg due to care in 2508 -- insns. 2509 Emit_Setcc_Reg 2510 (Reg, Insns.Ekind_Signed_To_Cc (Kind)); 2511 -- jne 2512 Gen_2 (Opc_Jcc + 2#0101#, 0); 2513 Pc := Get_Current_Pc; 2514 Gen_Grp1_Insn (Opc2_Grp1_Cmp, Stmt, Sz_32l); 2515 Emit_Setcc_Reg 2516 (Reg, Insns.Ekind_Unsigned_To_Cc (Kind)); 2517 Patch_8 (Pc - 1, Unsigned_8 (Get_Current_Pc - Pc)); 2518 return; 2519 end; 2520 end if; 2521 when Mode_F32 2522 | Mode_F64 => 2523 if Abi.Flag_Sse2 then 2524 -- comisd %xmm, rm 2525 Start_Insn; 2526 Init_Modrm_Expr (Get_Expr_Right (Stmt), Sz_32, 2527 Get_Expr_Reg (Left)); 2528 Gen_SSE_D16_Opc (Op_Mode, 16#2f#); 2529 Gen_Mod_Rm_Reg; 2530 End_Insn; 2531 else 2532 -- fcomip st, st(1) 2533 Start_Insn; 2534 Gen_8 (2#11011_111#); 2535 Gen_8 (2#1111_0001#); 2536 End_Insn; 2537 -- fstp st, st (0) 2538 Start_Insn; 2539 Gen_8 (2#11011_101#); 2540 Gen_8 (2#11_011_000#); 2541 End_Insn; 2542 end if; 2543 when others => 2544 Error_Emit ("emit_insn: cmp", Stmt); 2545 end case; 2546 -- Result is in eflags. 2547 pragma Assert (Get_Expr_Reg (Stmt) in Regs_Cc); 2548 end; 2549 when OE_Addrd => 2550 pragma Assert (Mode = Abi.Mode_Ptr); 2551 if Flags.M64 2552 and then not Insns.Is_External_Object (Get_Addr_Decl (Stmt)) 2553 then 2554 -- Use RIP relative to load an address. 2555 Emit_Lea (Stmt); 2556 else 2557 Emit_Load_Imm (Stmt, Sz_Ptr); 2558 end if; 2559 when OE_Const => 2560 case Mode is 2561 when Mode_B2 2562 | Mode_U8 2563 | Mode_I8 => 2564 Emit_Load_Imm (Stmt, Sz_8); 2565 when Mode_U32 2566 | Mode_I32 2567 | Mode_P32 => 2568 Emit_Load_Imm (Stmt, Sz_32); 2569 when Mode_I64 2570 | Mode_U64 2571 | Mode_P64 => 2572 if Flags.M64 then 2573 Emit_Load_Imm (Stmt, Sz_64); 2574 else 2575 pragma Assert (Mode /= Mode_P64); 2576 Emit_Load_Imm (Stmt, Sz_32l); 2577 Emit_Load_Imm (Stmt, Sz_32h); 2578 end if; 2579 when Mode_Fp => 2580 Emit_Load_Fp (Stmt, Mode); 2581 when others => 2582 Error_Emit ("emit_insn: const", Stmt); 2583 end case; 2584 when OE_Indir => 2585 case Mode is 2586 when Mode_U32 2587 | Mode_I32 2588 | Mode_P32 => 2589 Emit_Load_Mem (Stmt, Sz_32); 2590 when Mode_B2 2591 | Mode_U8 2592 | Mode_I8 => 2593 Emit_Load_Mem (Stmt, Sz_8); 2594 when Mode_U64 2595 | Mode_I64 2596 | Mode_P64 => 2597 if Flags.M64 then 2598 Emit_Load_Mem (Stmt, Sz_64); 2599 else 2600 pragma Assert (Mode /= Mode_P64); 2601 Emit_Load_Mem (Stmt, Sz_32l); 2602 Emit_Load_Mem (Stmt, Sz_32h); 2603 end if; 2604 when Mode_Fp => 2605 Emit_Load_Fp_Mem (Stmt, Mode); 2606 when others => 2607 Error_Emit ("emit_insn: indir", Stmt); 2608 end case; 2609 2610 when OE_Conv_Ov 2611 | OE_Conv => 2612 -- Call Gen_Conv_FROM 2613 case Get_Expr_Mode (Get_Expr_Operand (Stmt)) is 2614 when Mode_U32 => 2615 Gen_Conv_U32 (Stmt, Kind = OE_Conv_Ov); 2616 when Mode_I32 => 2617 Gen_Conv_I32 (Stmt, Kind = OE_Conv_Ov); 2618 when Mode_U8 => 2619 Gen_Conv_U8 (Stmt); 2620 when Mode_B2 => 2621 Gen_Conv_B2 (Stmt); 2622 when Mode_I64 => 2623 Gen_Conv_I64 (Stmt, Kind = OE_Conv_Ov); 2624 when Mode_F32 2625 | Mode_F64 => 2626 Gen_Conv_Fp (Stmt); 2627 when others => 2628 Error_Emit ("emit_insn: conv", Stmt); 2629 end case; 2630 2631 when OE_Asgn => 2632 case Mode is 2633 when Mode_U32 2634 | Mode_I32 2635 | Mode_P32 => 2636 Emit_Store (Stmt, Sz_32); 2637 when Mode_B2 2638 | Mode_U8 2639 | Mode_I8 => 2640 Emit_Store (Stmt, Sz_8); 2641 when Mode_U64 2642 | Mode_I64 2643 | Mode_P64 => 2644 if Flags.M64 then 2645 Emit_Store (Stmt, Sz_64); 2646 else 2647 Emit_Store (Stmt, Sz_32l); 2648 Emit_Store (Stmt, Sz_32h); 2649 end if; 2650 when Mode_Fp => 2651 if Abi.Flag_Sse2 then 2652 Emit_Store_Xmm (Stmt, Mode); 2653 else 2654 Emit_Store_Fp (Stmt, Mode); 2655 end if; 2656 when others => 2657 Error_Emit ("emit_insn: move", Stmt); 2658 end case; 2659 2660 when OE_Jump_F => 2661 Reg := Get_Expr_Reg (Get_Expr_Operand (Stmt)); 2662 if Reg not in Regs_Cc then 2663 Error_Emit ("emit_insn/jmp_f: not cc", Stmt); 2664 end if; 2665 Emit_Jmp_T (Stmt, Inverse_Cc (Reg)); 2666 when OE_Jump_T => 2667 Reg := Get_Expr_Reg (Get_Expr_Operand (Stmt)); 2668 if Reg not in Regs_Cc then 2669 Error_Emit ("emit_insn/jmp_t: not cc", Stmt); 2670 end if; 2671 Emit_Jmp_T (Stmt, Reg); 2672 when OE_Jump => 2673 Emit_Jmp (Stmt); 2674 when OE_Label => 2675 Emit_Label (Stmt); 2676 2677 when OE_Ret => 2678 -- Value already set. 2679 null; 2680 2681 when OE_Arg => 2682 -- Only arguments passed on the stack are represented by OE_Arg. 2683 -- Arguments passed by registers (for x86-64) are simply 2684 -- pre-computed. 2685 case Mode is 2686 when Mode_U32 2687 | Mode_I32 2688 | Mode_P32 => 2689 Emit_Push (Get_Expr_Operand (Stmt), Sz_32); 2690 when Mode_U64 2691 | Mode_I64 2692 | Mode_P64 => 2693 if Flags.M64 then 2694 Emit_Push (Get_Expr_Operand (Stmt), Sz_64); 2695 else 2696 Emit_Push (Get_Expr_Operand (Stmt), Sz_32h); 2697 Emit_Push (Get_Expr_Operand (Stmt), Sz_32l); 2698 end if; 2699 when Mode_Fp => 2700 Emit_Push_Fp (Get_Expr_Operand (Stmt), Mode); 2701 when others => 2702 Error_Emit ("emit_insn: oe_arg", Stmt); 2703 end case; 2704 when OE_Stack_Adjust => 2705 Emit_Stack_Adjust (Stmt); 2706 when OE_Call => 2707 Emit_Call (Stmt); 2708 when OE_Intrinsic => 2709 Emit_Intrinsic (Stmt); 2710 2711 when OE_Move => 2712 declare 2713 Operand : constant O_Enode := Get_Expr_Operand (Stmt); 2714 Op_Reg : constant O_Reg := Get_Expr_Reg (Operand); 2715 begin 2716 Reg := Get_Expr_Reg (Stmt); 2717 case Mode is 2718 when Mode_B2 => 2719 if Reg in Regs_R64 and then Op_Reg in Regs_Cc then 2720 Emit_Setcc (Stmt, Op_Reg); 2721 elsif (Reg = R_Eq or Reg = R_Ne) 2722 and then Op_Reg in Regs_R64 2723 then 2724 Emit_Tst (Op_Reg, Sz_8); 2725 else 2726 Error_Emit ("emit_insn: move/b2", Stmt); 2727 end if; 2728 when Mode_U32 2729 | Mode_I32 => 2730 Emit_Move (Operand, Sz_32, Reg); 2731 when Mode_U64 2732 | Mode_I64 2733 | Mode_P64 => 2734 pragma Assert (Flags.M64); 2735 Emit_Move (Operand, Sz_64, Reg); 2736 when Mode_F64 2737 | Mode_F32 => 2738 Emit_Move_Xmm (Operand, Mode, Reg); 2739 when others => 2740 Error_Emit ("emit_insn: move", Stmt); 2741 end case; 2742 end; 2743 2744 when OE_Alloca => 2745 pragma Assert (Mode = Abi.Mode_Ptr); 2746 Gen_Alloca (Stmt); 2747 2748 when OE_Set_Stack => 2749 Emit_Load_Mem (Stmt, Sz_Ptr); 2750 2751 when OE_Add 2752 | OE_Addrl => 2753 case Mode is 2754 when Mode_U32 2755 | Mode_I32 2756 | Mode_P32 => 2757 Emit_Lea (Stmt); 2758 when Mode_U64 2759 | Mode_I64 2760 | Mode_P64 => 2761 pragma Assert (Flags.M64); 2762 Emit_Lea (Stmt); 2763 when others => 2764 Error_Emit ("emit_insn: oe_add", Stmt); 2765 end case; 2766 2767 when OE_Spill => 2768 case Mode is 2769 when Mode_B2 2770 | Mode_U8 2771 | Mode_I8 => 2772 Emit_Spill (Stmt, Sz_8); 2773 when Mode_U32 2774 | Mode_I32 2775 | Mode_P32 => 2776 Emit_Spill (Stmt, Sz_32); 2777 when Mode_U64 2778 | Mode_I64 2779 | Mode_P64 => 2780 if Flags.M64 then 2781 Emit_Spill (Stmt, Sz_64); 2782 else 2783 Emit_Spill (Stmt, Sz_32l); 2784 Emit_Spill (Stmt, Sz_32h); 2785 end if; 2786 when Mode_F32 2787 | Mode_F64 => 2788 Emit_Spill_Xmm (Stmt, Mode); 2789 when others => 2790 Error_Emit ("emit_insn: spill", Stmt); 2791 end case; 2792 2793 when OE_Reload => 2794 declare 2795 Expr : constant O_Enode := Get_Expr_Operand (Stmt); 2796 begin 2797 Reg := Get_Expr_Reg (Stmt); 2798 case Mode is 2799 when Mode_B2 2800 | Mode_U8 2801 | Mode_I8 => 2802 Emit_Load (Reg, Expr, Sz_8); 2803 when Mode_U32 2804 | Mode_I32 2805 | Mode_P32 => 2806 Emit_Load (Reg, Expr, Sz_32); 2807 when Mode_U64 2808 | Mode_I64 2809 | Mode_P64 => 2810 if Flags.M64 then 2811 Emit_Load (Reg, Expr, Sz_64); 2812 else 2813 Emit_Load (Reg, Expr, Sz_32l); 2814 Emit_Load (Reg, Expr, Sz_32h); 2815 end if; 2816 when Mode_F32 2817 | Mode_F64 => 2818 pragma Assert (Reg in Regs_Xmm); 2819 -- movsd 2820 Start_Insn; 2821 Gen_SSE_Prefix (Mode_F64); 2822 Init_Modrm_Mem (Expr, Sz_Fp, Reg); 2823 Gen_SSE_Opc (Opc_Movsd_Xmm_M64); 2824 Gen_Mod_Rm_Reg; 2825 End_Insn; 2826 when others => 2827 Error_Emit ("emit_insn: reload", Stmt); 2828 end case; 2829 end; 2830 2831 when OE_Reg => 2832 Reg_Helper := Get_Expr_Reg (Stmt); 2833 2834 when OE_Case_Expr 2835 | OE_Case => 2836 null; 2837 2838 when OE_Line => 2839 if Flag_Debug /= Debug_None then 2840 Dwarf.Set_Line_Stmt (Get_Expr_Line_Number (Stmt)); 2841 Set_Current_Section (Sect_Text); 2842 end if; 2843 when others => 2844 Error_Emit ("cannot handle insn", Stmt); 2845 end case; 2846 end Emit_Insn; 2847 2848 function Get_Preserved_Regs return O_Reg_Bitmap is 2849 begin 2850 if Flags.M64 then 2851 if Flags.Win64 then 2852 return Preserved_Regs_Win64; 2853 else 2854 return Preserved_Regs_Lin64; 2855 end if; 2856 else 2857 return Preserved_Regs_32; 2858 end if; 2859 end Get_Preserved_Regs; 2860 2861 -- List of registers preserved accross calls. 2862 Preserved_Regs : constant O_Reg_Bitmap := Get_Preserved_Regs; 2863 2864 procedure Push_Reg (Reg : Regs_R64) is 2865 begin 2866 Gen_Push_Pop_Reg (Opc_Push_Reg, Reg, Sz_Ptr); 2867 end Push_Reg; 2868 2869 procedure Pop_Reg (Reg : Regs_R64) is 2870 begin 2871 Gen_Push_Pop_Reg (Opc_Pop_Reg, Reg, Sz_Ptr); 2872 end Pop_Reg; 2873 2874 procedure Gen_Sub_Sp (Imm : Int32) is 2875 begin 2876 Start_Insn; 2877 Init_Modrm_Reg (R_Sp, Sz_Ptr); 2878 Gen_Insn_Grp1 (Opc2_Grp1_Sub, Imm); 2879 End_Insn; 2880 end Gen_Sub_Sp; 2881 2882 procedure Emit_Prologue (Subprg : Subprogram_Data_Acc) 2883 is 2884 use Ortho_Code.Decls; 2885 use Ortho_Code.Flags; 2886 use Ortho_Code.X86.Insns; 2887 Sym : Symbol; 2888 Subprg_Decl : O_Dnode; 2889 Is_Global : Boolean; 2890 Frame_Size : Unsigned_32; 2891 Saved_Regs_Size : Unsigned_32; 2892 Has_Fp_Inter : Boolean; 2893 begin 2894 -- Switch to .text section and align the function (to avoid the nested 2895 -- function trick and for performance). 2896 Set_Current_Section (Sect_Text); 2897 Gen_Pow_Align (2); 2898 2899 -- Set symbol. 2900 Subprg_Decl := Subprg.D_Decl; 2901 Sym := Get_Decl_Symbol (Subprg_Decl); 2902 case Get_Decl_Storage (Subprg_Decl) is 2903 when O_Storage_Public 2904 | O_Storage_External => 2905 -- FIXME: should not accept the external case. 2906 Is_Global := True; 2907 when others => 2908 Is_Global := False; 2909 end case; 2910 Set_Symbol_Pc (Sym, Is_Global); 2911 Subprg_Pc := Get_Current_Pc; 2912 2913 -- Return address and saved frame pointer are preserved. 2914 Saved_Regs_Size := 2; 2915 for R in Preserved_Regs'Range loop 2916 if Preserved_Regs (R) and Reg_Used (R) then 2917 Saved_Regs_Size := Saved_Regs_Size + 1; 2918 end if; 2919 end loop; 2920 if Flags.M64 then 2921 Saved_Regs_Size := Saved_Regs_Size * 8; 2922 else 2923 Saved_Regs_Size := Saved_Regs_Size * 4; 2924 end if; 2925 2926 -- Compute frame size. 2927 -- Saved_Regs_Size must be added and substracted as the stack boundary 2928 -- can be larger than a reg size. 2929 Frame_Size := Unsigned_32 (Subprg.Stack_Max) + Saved_Regs_Size; 2930 -- Align. 2931 Frame_Size := (Frame_Size + X86.Flags.Stack_Boundary - 1) 2932 and not (X86.Flags.Stack_Boundary - 1); 2933 -- The bytes for saved regs are already allocated. 2934 Frame_Size := Frame_Size - Saved_Regs_Size; 2935 2936 -- Emit prolog. 2937 -- push %ebp / push %rbp 2938 Push_Reg (R_Bp); 2939 -- movl %esp, %ebp / movl %rsp, %rbp 2940 Start_Insn; 2941 Gen_Rex (16#48#); 2942 Gen_8 (Opc_Mov_Rm_Reg + 1); 2943 Gen_8 (2#11_100_101#); 2944 End_Insn; 2945 2946 -- Save int arguments (only on x86-64). 2947 Has_Fp_Inter := False; 2948 if Flags.M64 then 2949 declare 2950 Inter : O_Dnode; 2951 R : O_Reg; 2952 begin 2953 Inter := Get_Subprg_Interfaces (Subprg.D_Decl); 2954 while Inter /= O_Dnode_Null loop 2955 R := Get_Decl_Reg (Inter); 2956 if R in Regs_R64 then 2957 Push_Reg (R); 2958 -- Space for arguments was already counted in frame size. 2959 -- As the space is allocated by the push, don't allocate it 2960 -- later. 2961 Frame_Size := Frame_Size - 8; 2962 elsif R in Regs_Xmm then 2963 -- Need to save Xmm registers, but later. 2964 Has_Fp_Inter := True; 2965 else 2966 pragma Assert (R = R_None); 2967 null; 2968 end if; 2969 Inter := Get_Interface_Chain (Inter); 2970 end loop; 2971 end; 2972 end if; 2973 2974 -- subl XXX, %esp / subl XXX, %rsp 2975 if Frame_Size /= 0 then 2976 if not X86.Flags.Flag_Alloca_Call 2977 or else Frame_Size <= 4096 2978 then 2979 Gen_Sub_Sp (Int32 (Frame_Size)); 2980 else 2981 pragma Assert (not Flags.M64); 2982 -- mov stack_size,%eax 2983 Start_Insn; 2984 Gen_8 (Opc_Movl_Imm_Reg + To_Reg32 (R_Ax)); 2985 Gen_32 (Frame_Size); 2986 End_Insn; 2987 2988 Gen_Call (Chkstk_Symbol); 2989 end if; 2990 end if; 2991 2992 -- Save XMM arguments. 2993 if Flags.M64 and Has_Fp_Inter then 2994 declare 2995 Inter : O_Dnode; 2996 R : O_Reg; 2997 begin 2998 Inter := Get_Subprg_Interfaces (Subprg.D_Decl); 2999 while Inter /= O_Dnode_Null loop 3000 R := Get_Decl_Reg (Inter); 3001 if R in Regs_Xmm then 3002 Start_Insn; 3003 Gen_SSE_Prefix (Mode_F64); 3004 Init_Modrm_Offset (R_Bp, Get_Local_Offset (Inter), Sz_Fp, R); 3005 Gen_SSE_Opc (Opc_Movsd_M64_Xmm); 3006 Gen_Mod_Rm_Reg; 3007 End_Insn; 3008 -- No need to adjust frame_size, it was already allocated. 3009 end if; 3010 Inter := Get_Interface_Chain (Inter); 3011 end loop; 3012 end; 3013 end if; 3014 3015 if Flag_Profile then 3016 Gen_Call (Mcount_Symbol); 3017 end if; 3018 3019 -- Save preserved registers that are used in the function. 3020 for R in Preserved_Regs'Range loop 3021 if Preserved_Regs (R) and Reg_Used (R) then 3022 Push_Reg (R); 3023 end if; 3024 end loop; 3025 end Emit_Prologue; 3026 3027 procedure Emit_Epilogue (Subprg : Subprogram_Data_Acc) 3028 is 3029 use Ortho_Code.Decls; 3030 use Ortho_Code.Types; 3031 use Ortho_Code.Flags; 3032 use Ortho_Code.X86.Insns; 3033 Decl : O_Dnode; 3034 Mode : Mode_Type; 3035 begin 3036 -- Restore registers. 3037 for R in reverse Preserved_Regs'Range loop 3038 if Preserved_Regs (R) and Reg_Used (R) then 3039 Pop_Reg (R); 3040 end if; 3041 end loop; 3042 3043 Decl := Subprg.D_Decl; 3044 if Get_Decl_Kind (Decl) = OD_Function then 3045 Mode := Get_Type_Mode (Get_Decl_Type (Decl)); 3046 case Mode is 3047 when Mode_U8 3048 | Mode_B2 => 3049 -- movzx %al,%eax 3050 Start_Insn; 3051 Gen_8 (Opc_0f); 3052 Gen_8 (Opc2_0f_Movzx); 3053 Gen_8 (2#11_000_000#); 3054 End_Insn; 3055 when Mode_U32 3056 | Mode_I32 3057 | Mode_U64 3058 | Mode_I64 3059 | Mode_P32 3060 | Mode_P64 => 3061 null; 3062 when Mode_F32 3063 | Mode_F64 => 3064 if Abi.Flag_Sse2 and not Flags.M64 then 3065 -- movsd %xmm0, slot(%ebp) 3066 Start_Insn; 3067 Gen_SSE_Prefix (Mode); 3068 Init_Modrm_Offset 3069 (R_Bp, -Int32 (Cur_Subprg.Target.Fp_Slot), Sz_32); 3070 Gen_SSE_Opc (Opc_Movsd_M64_Xmm); 3071 Gen_Mod_Rm_Opc (2#00_000_000#); 3072 End_Insn; 3073 -- fldl slot(%ebp) [keep same modrm parameters] 3074 Start_Insn; 3075 Gen_8 (2#11011_001# + Mode_Fp_To_Mf (Mode)); 3076 Gen_Mod_Rm_Opc (2#00_000_000#); 3077 End_Insn; 3078 end if; 3079 when others => 3080 raise Program_Error; 3081 end case; 3082 end if; 3083 3084 -- leave; ret; 3085 Gen_1 (Opc_Leave); 3086 Gen_1 (Opc_Ret); 3087 3088 if Flag_Debug /= Debug_None then 3089 Set_Body_Info (Subprg.D_Body, Int32 (Get_Current_Pc - Subprg_Pc)); 3090 end if; 3091 end Emit_Epilogue; 3092 3093 procedure Emit_Subprg (Subprg : Subprogram_Data_Acc) 3094 is 3095 pragma Assert (Subprg = Cur_Subprg); 3096 Stmt : O_Enode; 3097 begin 3098 if Debug.Flag_Debug_Code2 then 3099 Abi.Disp_Subprg_Decl (Subprg.D_Decl); 3100 end if; 3101 3102 Emit_Prologue (Subprg); 3103 3104 Stmt := Subprg.E_Entry; 3105 loop 3106 Stmt := Get_Stmt_Link (Stmt); 3107 3108 if Debug.Flag_Debug_Code2 then 3109 Abi.Disp_Stmt (Stmt); 3110 end if; 3111 3112 Emit_Insn (Stmt); 3113 exit when Get_Expr_Kind (Stmt) = OE_Leave; 3114 end loop; 3115 3116 Emit_Epilogue (Subprg); 3117 end Emit_Subprg; 3118 3119 procedure Emit_Var_Decl (Decl : O_Dnode) 3120 is 3121 use Decls; 3122 Sym : Symbol; 3123 begin 3124 Sym := Create_Symbol (Get_Decl_Ident (Decl), False); 3125 Set_Decl_Info (Decl, To_Int32 (Uns32 (Sym))); 3126 end Emit_Var_Decl; 3127 3128 procedure Emit_Var_Zero (Decl : O_Dnode) 3129 is 3130 use Decls; 3131 use Types; 3132 Sym : constant Symbol := Symbol (To_Uns32 (Get_Decl_Info (Decl))); 3133 Storage : constant O_Storage := Get_Decl_Storage (Decl); 3134 Dtype : constant O_Tnode := Get_Decl_Type (Decl); 3135 begin 3136 Set_Current_Section (Sect_Bss); 3137 pragma Assert (Storage = O_Storage_Public 3138 or Storage = O_Storage_Private); 3139 Gen_Pow_Align (Get_Type_Align (Dtype)); 3140 Set_Symbol_Pc (Sym, Storage = O_Storage_Public); 3141 Gen_Space (Integer_32 (Get_Type_Size (Dtype))); 3142 Set_Current_Section (Sect_Text); 3143 end Emit_Var_Zero; 3144 3145 procedure Emit_Const_Decl (Decl : O_Dnode) 3146 is 3147 use Decls; 3148 Sym : Symbol; 3149 begin 3150 Set_Current_Section (Sect_Rodata); 3151 Sym := Create_Symbol (Get_Decl_Ident (Decl), False); 3152 Set_Decl_Info (Decl, To_Int32 (Uns32 (Sym))); 3153 Set_Current_Section (Sect_Text); 3154 end Emit_Const_Decl; 3155 3156 procedure Emit_Const (Val : O_Cnode) 3157 is 3158 use Consts; 3159 use Types; 3160 H, L : Uns32; 3161 begin 3162 case Get_Const_Kind (Val) is 3163 when OC_Signed 3164 | OC_Unsigned 3165 | OC_Float 3166 | OC_Null 3167 | OC_Lit => 3168 Get_Const_Bytes (Val, H, L); 3169 case Get_Type_Mode (Get_Const_Type (Val)) is 3170 when Mode_U8 3171 | Mode_I8 3172 | Mode_B2 => 3173 Gen_8 (Byte (L)); 3174 when Mode_U32 3175 | Mode_I32 3176 | Mode_F32 3177 | Mode_P32 => 3178 Gen_32 (Unsigned_32 (L)); 3179 when Mode_F64 3180 | Mode_I64 3181 | Mode_U64 3182 | Mode_P64 => 3183 Gen_32 (Unsigned_32 (L)); 3184 Gen_32 (Unsigned_32 (H)); 3185 when others => 3186 raise Program_Error; 3187 end case; 3188 when OC_Address => 3189 declare 3190 Decl : O_Dnode; 3191 Off : Uns32; 3192 begin 3193 Get_Global_Decl_Offset (Get_Const_Global (Val), Decl, Off); 3194 Gen_Abs (Get_Decl_Symbol (Decl), Integer_32 (To_Int32 (Off))); 3195 end; 3196 when OC_Subprg_Address => 3197 Gen_Abs (Get_Decl_Symbol (Get_Const_Decl (Val)), 0); 3198 when OC_Array => 3199 for I in 0 .. Get_Const_Aggr_Length (Val) - 1 loop 3200 Emit_Const (Get_Const_Aggr_Element (Val, I)); 3201 end loop; 3202 when OC_Record => 3203 declare 3204 E : O_Cnode; 3205 begin 3206 for I in 0 .. Get_Const_Aggr_Length (Val) - 1 loop 3207 E := Get_Const_Aggr_Element (Val, I); 3208 Gen_Pow_Align (Get_Type_Align (Get_Const_Type (E))); 3209 Emit_Const (E); 3210 end loop; 3211 end; 3212 when OC_Zero => 3213 for I in 1 .. Get_Type_Size (Get_Const_Type (Val)) loop 3214 Gen_8 (0); 3215 end loop; 3216 when OC_Sizeof 3217 | OC_Record_Sizeof 3218 | OC_Alignof 3219 | OC_Union => 3220 raise Program_Error; 3221 end case; 3222 end Emit_Const; 3223 3224 procedure Emit_Init_Value (Decl : O_Dnode; Val : O_Cnode) 3225 is 3226 use Decls; 3227 use Types; 3228 Sym : constant Symbol := Get_Decl_Symbol (Decl); 3229 Dtype : constant O_Tnode := Get_Decl_Type (Decl); 3230 begin 3231 case Get_Decl_Kind (Decl) is 3232 when OD_Const => 3233 Set_Current_Section (Sect_Rodata); 3234 when OD_Var => 3235 Set_Current_Section (Sect_Rodata); 3236 when others => 3237 raise Syntax_Error; 3238 end case; 3239 3240 Gen_Pow_Align (Get_Type_Align (Dtype)); 3241 Set_Symbol_Pc (Sym, Get_Decl_Storage (Decl) = O_Storage_Public); 3242 Prealloc (Pc_Type (Consts.Get_Const_Size (Val))); 3243 Emit_Const (Val); 3244 3245 Set_Current_Section (Sect_Text); 3246 end Emit_Init_Value; 3247 3248 procedure Init 3249 is 3250 use Ortho_Ident; 3251 use Ortho_Code.Flags; 3252 begin 3253 if Flags.M64 then 3254 Arch := Arch_X86_64; 3255 else 3256 Arch := Arch_X86; 3257 end if; 3258 3259 Create_Section (Sect_Text, ".text", Section_Exec + Section_Read); 3260 Create_Section (Sect_Rodata, ".rodata", Section_Read); 3261 Create_Section (Sect_Bss, ".bss", 3262 Section_Read + Section_Write + Section_Zero); 3263 3264 Set_Current_Section (Sect_Text); 3265 3266 if Flag_Profile then 3267 Mcount_Symbol := Create_Symbol (Get_Identifier ("mcount"), True); 3268 end if; 3269 3270 if X86.Flags.Flag_Alloca_Call then 3271 Chkstk_Symbol := Create_Symbol (Get_Identifier ("___chkstk"), True); 3272 end if; 3273 3274 if not Flags.M64 then 3275 Intrinsics_Symbol (Intrinsic_Mul_Ov_U64) := 3276 Create_Symbol (Get_Identifier ("__muldi3"), True); 3277 Intrinsics_Symbol (Intrinsic_Div_Ov_U64) := 3278 Create_Symbol (Get_Identifier ("__mcode_div_ov_u64"), True); 3279 Intrinsics_Symbol (Intrinsic_Mod_Ov_U64) := 3280 Create_Symbol (Get_Identifier ("__mcode_mod_ov_u64"), True); 3281 Intrinsics_Symbol (Intrinsic_Mul_Ov_I64) := 3282 Create_Symbol (Get_Identifier ("__muldi3"), True); 3283 Intrinsics_Symbol (Intrinsic_Div_Ov_I64) := 3284 Create_Symbol (Get_Identifier ("__divdi3"), True); 3285 Intrinsics_Symbol (Intrinsic_Mod_Ov_I64) := 3286 Create_Symbol (Get_Identifier ("__mcode_mod_ov_i64"), True); 3287 Intrinsics_Symbol (Intrinsic_Rem_Ov_I64) := 3288 Create_Symbol (Get_Identifier ("__mcode_rem_ov_i64"), True); 3289 end if; 3290 3291 if Debug.Flag_Debug_Asm then 3292 Dump_Asm := True; 3293 end if; 3294 if Debug.Flag_Debug_Hex then 3295 Debug_Hex := True; 3296 end if; 3297 3298 if Flag_Debug /= Debug_None then 3299 Dwarf.Init; 3300 Set_Current_Section (Sect_Text); 3301 end if; 3302 end Init; 3303 3304 procedure Finish 3305 is 3306 use Ortho_Code.Flags; 3307 begin 3308 if Flag_Debug /= Debug_None then 3309 Set_Current_Section (Sect_Text); 3310 Dwarf.Finish; 3311 end if; 3312 end Finish; 3313 3314end Ortho_Code.X86.Emits; 3315