1 { 2 Copyright (c) 1998-2002 by Florian Klaempfl 3 4 Generate for x86-64 and i386 assembler for type converting nodes 5 6 This program is free software; you can redistribute it and/or modify 7 it under the terms of the GNU General Public License as published by 8 the Free Software Foundation; either version 2 of the License, or 9 (at your option) any later version. 10 11 This program is distributed in the hope that it will be useful, 12 but WITHOUT ANY WARRANTY; without even the implied warranty of 13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 GNU General Public License for more details. 15 16 You should have received a copy of the GNU General Public License 17 along with this program; if not, write to the Free Software 18 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 19 20 **************************************************************************** 21 } 22 unit nx86cnv; 23 24 {$i fpcdefs.inc} 25 26 interface 27 28 uses 29 node,ncgcnv,defutil; 30 31 type 32 tx86typeconvnode = class(tcgtypeconvnode) 33 protected first_real_to_realnull34 function first_real_to_real : tnode;override; 35 { procedure second_int_to_int;override; } 36 { procedure second_string_to_string;override; } 37 { procedure second_cstring_to_pchar;override; } 38 { procedure second_string_to_chararray;override; } 39 { procedure second_array_to_pointer;override; } 40 { procedure second_pointer_to_array;override; } 41 { procedure second_chararray_to_string;override; } 42 { procedure second_char_to_string;override; } first_int_to_realnull43 function first_int_to_real: tnode; override; 44 procedure second_int_to_real;override; 45 { procedure second_real_to_real;override; } 46 { procedure second_cord_to_pointer;override; } 47 { procedure second_proc_to_procvar;override; } 48 { procedure second_bool_to_int;override; } 49 procedure second_int_to_bool;override; 50 { procedure second_set_to_set;override; } 51 { procedure second_ansistring_to_pchar;override; } 52 { procedure second_pchar_to_string;override; } 53 { procedure second_class_to_intf;override; } 54 { procedure second_char_to_char;override; } 55 end; 56 57 58 implementation 59 60 uses 61 verbose,globals,globtype, 62 aasmbase,aasmtai,aasmdata,aasmcpu, 63 symconst,symdef, 64 cgbase,cga,pass_1,pass_2, 65 cpuinfo, 66 ncnv, 67 cpubase, 68 cgutils,cgobj,hlcgobj,cgx86, 69 tgobj; 70 71 tx86typeconvnode.first_real_to_realnull72 function tx86typeconvnode.first_real_to_real : tnode; 73 begin 74 first_real_to_real:=nil; 75 { comp isn't a floating type } 76 if (tfloatdef(resultdef).floattype=s64comp) and 77 (tfloatdef(left.resultdef).floattype<>s64comp) and 78 not (nf_explicit in flags) then 79 CGMessage(type_w_convert_real_2_comp); 80 if use_vectorfpu(resultdef) then 81 expectloc:=LOC_MMREGISTER 82 else 83 expectloc:=LOC_FPUREGISTER; 84 end; 85 86 87 procedure tx86typeconvnode.second_int_to_bool; 88 var 89 {$ifndef cpu64bitalu} 90 hreg2, 91 hregister : tregister; 92 href : treference; 93 i : integer; 94 {$endif not cpu64bitalu} 95 resflags : tresflags; 96 hlabel : tasmlabel; 97 newsize : tcgsize; 98 begin 99 secondpass(left); 100 if codegenerror then 101 exit; 102 { Explicit typecasts from any ordinal type to a boolean type } 103 { must not change the ordinal value } 104 if (nf_explicit in flags) and 105 not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) then 106 begin 107 location_copy(location,left.location); 108 newsize:=def_cgsize(resultdef); 109 { change of size? change sign only if location is LOC_(C)REGISTER? Then we have to sign/zero-extend } 110 if (tcgsize2size[newsize]<>tcgsize2size[left.location.size]) or 111 ((newsize<>left.location.size) and (location.loc in [LOC_REGISTER,LOC_CREGISTER])) then 112 hlcg.location_force_reg(current_asmdata.CurrAsmList,location,left.resultdef,resultdef,true) 113 else 114 location.size:=newsize; 115 exit; 116 end; 117 118 { Load left node into flag F_NE/F_E } 119 resflags:=F_NE; 120 121 if (left.location.loc in [LOC_SUBSETREG,LOC_CSUBSETREG,LOC_SUBSETREF,LOC_CSUBSETREF]) then 122 hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true); 123 124 case left.location.loc of 125 LOC_CREFERENCE, 126 LOC_REFERENCE : 127 begin 128 {$ifndef cpu64bitalu} 129 if left.location.size in [OS_64,OS_S64{$ifdef cpu16bitalu},OS_32,OS_S32{$endif}] then 130 begin 131 hregister:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); 132 cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,left.location.reference,hregister); 133 href:=left.location.reference; 134 for i:=2 to tcgsize2size[left.location.size] div tcgsize2size[OS_INT] do 135 begin 136 inc(href.offset,tcgsize2size[OS_INT]); 137 cg.a_op_ref_reg(current_asmdata.CurrAsmList,OP_OR,OS_INT,href,hregister); 138 end; 139 end 140 else 141 {$endif not cpu64bitalu} 142 begin 143 hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true); 144 cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_OR,left.location.size,left.location.register,left.location.register); 145 end; 146 end; 147 LOC_FLAGS : 148 begin 149 resflags:=left.location.resflags; 150 end; 151 LOC_REGISTER,LOC_CREGISTER : 152 begin 153 {$if defined(cpu32bitalu)} 154 if left.location.size in [OS_64,OS_S64] then 155 begin 156 hregister:=cg.getintregister(current_asmdata.CurrAsmList,OS_32); 157 cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_32,OS_32,left.location.register64.reglo,hregister); 158 cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_32,left.location.register64.reghi,hregister); 159 end 160 else 161 {$elseif defined(cpu16bitalu)} 162 if left.location.size in [OS_64,OS_S64] then 163 begin 164 hregister:=cg.getintregister(current_asmdata.CurrAsmList,OS_16); 165 cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_16,OS_16,left.location.register64.reglo,hregister); 166 cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_16,cg.GetNextReg(left.location.register64.reglo),hregister); 167 cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_16,left.location.register64.reghi,hregister); 168 cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_16,cg.GetNextReg(left.location.register64.reghi),hregister); 169 end 170 else 171 if left.location.size in [OS_32,OS_S32] then 172 cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_16,left.location.register,cg.GetNextReg(left.location.register)) 173 else 174 {$endif} 175 cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_OR,left.location.size,left.location.register,left.location.register); 176 end; 177 LOC_JUMP : 178 begin 179 location_reset(location,LOC_REGISTER,def_cgsize(resultdef)); 180 location.register:=cg.getintregister(current_asmdata.CurrAsmList,location.size); 181 current_asmdata.getjumplabel(hlabel); 182 cg.a_label(current_asmdata.CurrAsmList,left.location.truelabel); 183 if not(is_cbool(resultdef)) then 184 cg.a_load_const_reg(current_asmdata.CurrAsmList,location.size,1,location.register) 185 else 186 cg.a_load_const_reg(current_asmdata.CurrAsmList,location.size,-1,location.register); 187 cg.a_jmp_always(current_asmdata.CurrAsmList,hlabel); 188 cg.a_label(current_asmdata.CurrAsmList,left.location.falselabel); 189 cg.a_load_const_reg(current_asmdata.CurrAsmList,location.size,0,location.register); 190 cg.a_label(current_asmdata.CurrAsmList,hlabel); 191 end; 192 else 193 internalerror(10062); 194 end; 195 if (left.location.loc<>LOC_JUMP) then 196 begin 197 { load flags to register } 198 location_reset(location,LOC_REGISTER,def_cgsize(resultdef)); 199 {$ifndef cpu64bitalu} 200 if (location.size in [OS_64,OS_S64]) then 201 begin 202 hreg2:=cg.getintregister(current_asmdata.CurrAsmList,OS_32); 203 cg.g_flags2reg(current_asmdata.CurrAsmList,OS_32,resflags,hreg2); 204 if (is_cbool(resultdef)) then 205 cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NEG,OS_32,hreg2,hreg2); 206 location.register64.reglo:=hreg2; 207 location.register64.reghi:=cg.getintregister(current_asmdata.CurrAsmList,OS_32); 208 if (is_cbool(resultdef)) then 209 { reglo is either 0 or -1 -> reghi has to become the same } 210 cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_32,OS_32,location.register64.reglo,location.register64.reghi) 211 else 212 { unsigned } 213 cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_32,0,location.register64.reghi); 214 end 215 else 216 {$endif not cpu64bitalu} 217 begin 218 location.register:=cg.getintregister(current_asmdata.CurrAsmList,location.size); 219 cg.g_flags2reg(current_asmdata.CurrAsmList,location.size,resflags,location.register); 220 if (is_cbool(resultdef)) then 221 cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NEG,location.size,location.register,location.register); 222 end 223 end; 224 end; 225 226 tx86typeconvnode.first_int_to_realnull227 function tx86typeconvnode.first_int_to_real : tnode; 228 229 begin 230 first_int_to_real:=nil; 231 if (left.resultdef.size<4) then 232 begin 233 inserttypeconv(left,s32inttype); 234 firstpass(left) 235 end; 236 237 if use_vectorfpu(resultdef) and 238 (torddef(left.resultdef).ordtype = s32bit) then 239 expectloc:=LOC_MMREGISTER 240 else 241 expectloc:=LOC_FPUREGISTER; 242 end; 243 244 245 procedure tx86typeconvnode.second_int_to_real; 246 247 var 248 leftref, 249 href : treference; 250 l1,l2 : tasmlabel; 251 op: tasmop; 252 opsize: topsize; 253 signtested : boolean; 254 use_bt: boolean; { true = use BT (386+), false = use TEST (286-) } 255 begin 256 {$ifdef i8086} 257 use_bt:=current_settings.cputype>=cpu_386; 258 {$else i8086} 259 use_bt:=true; 260 {$endif i8086} 261 if not(left.location.loc in [LOC_REGISTER,LOC_CREGISTER,LOC_REFERENCE,LOC_CREFERENCE]) then 262 hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,false); 263 if use_vectorfpu(resultdef) and 264 {$ifdef cpu64bitalu} 265 (torddef(left.resultdef).ordtype in [s32bit,s64bit]) then 266 {$else cpu64bitalu} 267 (torddef(left.resultdef).ordtype=s32bit) then 268 {$endif cpu64bitalu} 269 begin 270 location_reset(location,LOC_MMREGISTER,def_cgsize(resultdef)); 271 location.register:=cg.getmmregister(current_asmdata.CurrAsmList,location.size); 272 if UseAVX then 273 case location.size of 274 OS_F32: 275 op:=A_VCVTSI2SS; 276 OS_F64: 277 op:=A_VCVTSI2SD; 278 else 279 internalerror(2007120902); 280 end 281 else 282 case location.size of 283 OS_F32: 284 op:=A_CVTSI2SS; 285 OS_F64: 286 op:=A_CVTSI2SD; 287 else 288 internalerror(2007120902); 289 end; 290 291 { don't use left.location.size, because that one may be OS_32/OS_64 292 if the lower bound of the orddef >= 0 293 } 294 case torddef(left.resultdef).ordtype of 295 s32bit: 296 opsize:=S_L; 297 s64bit: 298 opsize:=S_Q; 299 else 300 internalerror(2007120903); 301 end; 302 case left.location.loc of 303 LOC_REFERENCE, 304 LOC_CREFERENCE: 305 begin 306 href:=left.location.reference; 307 tcgx86(cg).make_simple_ref(current_asmdata.CurrAsmList,href); 308 if UseAVX then 309 { VCVTSI2.. requires a second source operand to copy bits 64..127 } 310 current_asmdata.CurrAsmList.concat(taicpu.op_ref_reg_reg(op,opsize,href,location.register,location.register)) 311 else 312 current_asmdata.CurrAsmList.concat(taicpu.op_ref_reg(op,opsize,href,location.register)); 313 end; 314 LOC_REGISTER, 315 LOC_CREGISTER: 316 if UseAVX then 317 { VCVTSI2.. requires a second source operand to copy bits 64..127 } 318 current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(op,opsize,left.location.register,location.register,location.register)) 319 else 320 current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op,opsize,left.location.register,location.register)); 321 end; 322 end 323 else 324 begin 325 location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef)); 326 if (left.location.loc=LOC_REGISTER) and (torddef(left.resultdef).ordtype=u64bit) then 327 begin 328 if use_bt then 329 begin 330 {$if defined(cpu64bitalu)} 331 emit_const_reg(A_BT,S_Q,63,left.location.register); 332 {$elseif defined(cpu32bitalu)} 333 emit_const_reg(A_BT,S_L,31,left.location.register64.reghi); 334 {$elseif defined(cpu16bitalu)} 335 emit_const_reg(A_BT,S_W,15,cg.GetNextReg(left.location.register64.reghi)); 336 {$endif} 337 end 338 else 339 begin 340 {$ifdef i8086} 341 emit_const_reg(A_TEST,S_W,aint($8000),cg.GetNextReg(left.location.register64.reghi)); 342 {$else i8086} 343 internalerror(2013052510); 344 {$endif i8086} 345 end; 346 signtested:=true; 347 end 348 else 349 signtested:=false; 350 351 { We need to load from a reference } 352 hlcg.location_force_mem(current_asmdata.CurrAsmList,left.location,left.resultdef); 353 { don't change left.location.reference, because if it's a temp we 354 need the original location at the end so we can free it } 355 leftref:=left.location.reference; 356 tcgx86(cg).make_simple_ref(current_asmdata.CurrAsmList,leftref); 357 358 { For u32bit we need to load it as comp and need to 359 make it 64bits } 360 if (torddef(left.resultdef).ordtype=u32bit) then 361 begin 362 tg.GetTemp(current_asmdata.CurrAsmList,8,8,tt_normal,href); 363 location_freetemp(current_asmdata.CurrAsmList,left.location); 364 cg.a_load_ref_ref(current_asmdata.CurrAsmList,left.location.size,OS_32,leftref,href); 365 inc(href.offset,4); 366 cg.a_load_const_ref(current_asmdata.CurrAsmList,OS_32,0,href); 367 dec(href.offset,4); 368 { could be a temp with an offset > 32 bit on x86_64 } 369 tcgx86(cg).make_simple_ref(current_asmdata.CurrAsmList,href); 370 leftref:=href; 371 end; 372 373 { Load from reference to fpu reg } 374 case torddef(left.resultdef).ordtype of 375 u32bit, 376 scurrency, 377 s64bit: 378 begin 379 current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_FILD,S_IQ,leftref)); 380 end; 381 u64bit: 382 begin 383 { unsigned 64 bit ints are harder to handle: 384 we load bits 0..62 and then check bit 63: 385 if it is 1 then we add 2**64 as float. 386 Since 2**64 can be represented exactly, use a single-precision 387 constant to save space. } 388 current_asmdata.getglobaldatalabel(l1); 389 current_asmdata.getjumplabel(l2); 390 391 if not(signtested) then 392 begin 393 if use_bt then 394 begin 395 {$if defined(cpu64bitalu) or defined(cpu32bitalu)} 396 inc(leftref.offset,4); 397 emit_const_ref(A_BT,S_L,31,leftref); 398 dec(leftref.offset,4); 399 {$elseif defined(cpu16bitalu)} 400 inc(leftref.offset,6); 401 emit_const_ref(A_BT,S_W,15,leftref); 402 dec(leftref.offset,6); 403 {$endif} 404 end 405 else 406 begin 407 {$ifdef i8086} 408 { reading a byte, instead of word is faster on a true } 409 { 8088, because of the 8-bit data bus } 410 inc(leftref.offset,7); 411 emit_const_ref(A_TEST,S_B,aint($80),leftref); 412 dec(leftref.offset,7); 413 {$else i8086} 414 internalerror(2013052511); 415 {$endif i8086} 416 end; 417 end; 418 419 current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_FILD,S_IQ,leftref)); 420 if use_bt then 421 cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NC,l2) 422 else 423 cg.a_jmp_flags(current_asmdata.CurrAsmList,F_E,l2); 424 new_section(current_asmdata.asmlists[al_typedconsts],sec_rodata_norel,l1.name,const_align(sizeof(pint))); 425 current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(l1)); 426 { I got this constant from a test program (FK) } 427 current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_32bit($5f800000)); 428 reference_reset_symbol(href,l1,0,4,[]); 429 tcgx86(cg).make_simple_ref(current_asmdata.CurrAsmList,href); 430 current_asmdata.CurrAsmList.concat(Taicpu.Op_ref(A_FADD,S_FS,href)); 431 cg.a_label(current_asmdata.CurrAsmList,l2); 432 end 433 else 434 begin 435 if left.resultdef.size<4 then 436 internalerror(2007120901); 437 current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_FILD,S_IL,leftref)); 438 end; 439 end; 440 tcgx86(cg).inc_fpu_stack; 441 location.register:=NR_ST; 442 end; 443 location_freetemp(current_asmdata.CurrAsmList,left.location); 444 end; 445 446 begin 447 ctypeconvnode:=tx86typeconvnode 448 end. 449