1 { 2 Copyright (c) 1998-2002 by Florian Klaempfl 3 4 Generate SPARC 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 unit ncpucnv; 22 23 {$i fpcdefs.inc} 24 25 interface 26 27 uses 28 node,ncnv,ncgcnv,defcmp; 29 30 type 31 tsparctypeconvnode = class(TCgTypeConvNode) 32 protected 33 { procedure second_int_to_int;override; } 34 { procedure second_string_to_string;override; } 35 { procedure second_cstring_to_pchar;override; } 36 { procedure second_string_to_chararray;override; } 37 { procedure second_array_to_pointer;override; } first_int_to_realnull38 function first_int_to_real: tnode; override; 39 { procedure second_pointer_to_array;override; } 40 { procedure second_chararray_to_string;override; } 41 { procedure second_char_to_string;override; } 42 procedure second_int_to_real;override; 43 { procedure second_real_to_real;override; } 44 { procedure second_cord_to_pointer;override; } 45 { procedure second_proc_to_procvar;override; } 46 { procedure second_bool_to_int;override; } 47 procedure second_int_to_bool;override; 48 { procedure second_load_smallset;override; } 49 { procedure second_ansistring_to_pchar;override; } 50 { procedure second_pchar_to_string;override; } 51 { procedure second_class_to_intf;override; } 52 { procedure second_char_to_char;override; } 53 end; 54 55 implementation 56 57 uses 58 verbose,globals,systems,globtype, 59 symconst,symdef,aasmbase,aasmtai,aasmdata, 60 defutil, 61 cgbase,cgutils,pass_1,pass_2, 62 ncon,ncal,procinfo, 63 ncgutil, 64 cpuinfo,cpubase,aasmcpu, 65 tgobj,cgobj, 66 hlcgobj; 67 68 69 {***************************************************************************** 70 FirstTypeConv 71 *****************************************************************************} 72 tsparctypeconvnode.first_int_to_realnull73 function tsparctypeconvnode.first_int_to_real: tnode; 74 var 75 fname: string[19]; 76 begin 77 { converting a 64bit integer to a float requires a helper } 78 if is_64bitint(left.resultdef) or 79 is_currency(left.resultdef) then 80 begin 81 { hack to avoid double division by 10000, as it's 82 already done by typecheckpass.resultdef_int_to_real } 83 if is_currency(left.resultdef) then 84 left.resultdef := s64inttype; 85 if is_signed(left.resultdef) then 86 fname := 'fpc_int64_to_double' 87 else 88 fname := 'fpc_qword_to_double'; 89 result := ccallnode.createintern(fname,ccallparanode.create( 90 left,nil)); 91 left:=nil; 92 if (tfloatdef(resultdef).floattype=s32real) then 93 inserttypeconv(result,s32floattype); 94 firstpass(result); 95 exit; 96 end 97 else 98 { other integers are supposed to be 32 bit } 99 begin 100 if is_signed(left.resultdef) then 101 inserttypeconv(left,s32inttype) 102 else 103 begin 104 inserttypeconv(left,u32inttype); 105 if (cs_create_pic in current_settings.moduleswitches) and 106 (tf_pic_uses_got in target_info.flags) then 107 include(current_procinfo.flags,pi_needs_got); 108 end; 109 firstpass(left); 110 end; 111 result := nil; 112 expectloc:=LOC_FPUREGISTER; 113 end; 114 115 116 {***************************************************************************** 117 SecondTypeConv 118 *****************************************************************************} 119 120 procedure tsparctypeconvnode.second_int_to_real; 121 122 procedure loadsigned; 123 begin 124 hlcg.location_force_mem(current_asmdata.CurrAsmList,left.location,left.resultdef); 125 { Load memory in fpu register } 126 cg.a_loadfpu_ref_reg(current_asmdata.CurrAsmList,OS_F32,OS_F32,left.location.reference,location.register); 127 tg.ungetiftemp(current_asmdata.CurrAsmList,left.location.reference); 128 { Convert value in fpu register from integer to float } 129 case tfloatdef(resultdef).floattype of 130 s32real: 131 current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FiTOs,location.register,location.register)); 132 s64real: 133 current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FiTOd,location.register,location.register)); 134 s128real: 135 current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FiTOq,location.register,location.register)); 136 else 137 internalerror(200408011); 138 end; 139 end; 140 141 var 142 href : treference; 143 hregister : tregister; 144 l1,l2 : tasmlabel; 145 TempFlags : TResFlags; 146 147 begin 148 location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef)); 149 if is_signed(left.resultdef) then 150 begin 151 location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size); 152 loadsigned; 153 end 154 else 155 begin 156 current_asmdata.getglobaldatalabel(l1); 157 current_asmdata.getjumplabel(l2); 158 reference_reset_symbol(href,l1,0,8,[]); 159 hregister:=cg.getintregister(current_asmdata.CurrAsmList,OS_32); 160 hlcg.a_load_loc_reg(current_asmdata.CurrAsmList,left.resultdef,u32inttype,left.location,hregister); 161 162 { here we need always an 64 bit register } 163 location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,OS_F64); 164 hlcg.location_force_mem(current_asmdata.CurrAsmList,left.location,left.resultdef); 165 { Load memory in fpu register } 166 cg.a_loadfpu_ref_reg(current_asmdata.CurrAsmList,OS_F32,OS_F32,left.location.reference,location.register); 167 tg.ungetiftemp(current_asmdata.CurrAsmList,left.location.reference); 168 current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FiTOd,location.register,location.register)); 169 170 current_asmdata.CurrAsmList.concat(Taicpu.op_reg_reg(A_CMP,hregister,NR_G0)); 171 TempFlags.Init(NR_ICC,F_GE); 172 cg.a_jmp_flags(current_asmdata.CurrAsmList,TempFlags,l2); 173 174 case tfloatdef(resultdef).floattype of 175 { converting dword to s64real first and cut off at the end avoids precision loss } 176 s32real, 177 s64real: 178 begin 179 hregister:=cg.getfpuregister(current_asmdata.CurrAsmList,OS_F64); 180 new_section(current_asmdata.asmlists[al_typedconsts],sec_rodata_norel,l1.name,const_align(8)); 181 current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(l1)); 182 { I got this constant from a test program (FK) } 183 current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_32bit($41f00000)); 184 current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_32bit(0)); 185 186 cg.a_loadfpu_ref_reg(current_asmdata.CurrAsmList,OS_F64,OS_F64,href,hregister); 187 current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_FADDD,location.register,hregister,location.register)); 188 cg.a_label(current_asmdata.CurrAsmList,l2); 189 190 { cut off if we should convert to single } 191 if tfloatdef(resultdef).floattype=s32real then 192 begin 193 hregister:=location.register; 194 location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size); 195 current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FDTOS,hregister,location.register)); 196 end; 197 end; 198 else 199 internalerror(200410031); 200 end; 201 end; 202 end; 203 204 205 (* 206 procedure tsparctypeconvnode.second_real_to_real; 207 const 208 conv_op : array[tfloattype,tfloattype] of tasmop = ( 209 { from: s32 s64 s80 sc80 c64 cur f128 } 210 { s32 } ( A_FMOVS,A_FDTOS,A_NONE, A_NONE, A_NONE, A_NONE, A_NONE ), 211 { s64 } ( A_FSTOD,A_FMOVD,A_NONE, A_NONE, A_NONE, A_NONE, A_NONE ), 212 { s80 } ( A_NONE, A_NONE, A_NONE, A_NONE, A_NONE, A_NONE, A_NONE ), 213 { sc80 } ( A_NONE, A_NONE, A_NONE, A_NONE, A_NONE, A_NONE, A_NONE ), 214 { c64 } ( A_NONE, A_NONE, A_NONE, A_NONE, A_NONE, A_NONE, A_NONE ), 215 { cur } ( A_NONE, A_NONE, A_NONE, A_NONE, A_NONE, A_NONE, A_NONE ), 216 { f128 } ( A_NONE, A_NONE, A_NONE, A_NONE, A_NONE, A_NONE, A_NONE ) 217 ); 218 var 219 op : tasmop; 220 begin 221 location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef)); 222 hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,false); 223 { Convert value in fpu register from integer to float } 224 op:=conv_op[tfloatdef(resultdef).floattype,tfloatdef(left.resultdef).floattype]; 225 if op=A_NONE then 226 internalerror(200401121); 227 location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size); 228 current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op,left.location.register,location.register)); 229 end; 230 *) 231 232 procedure tsparctypeconvnode.second_int_to_bool; 233 var 234 href: treference; 235 hreg1,hreg2 : tregister; 236 resflags : tresflags; 237 opsize : tcgsize; 238 hlabel : tasmlabel; 239 newsize : tcgsize; 240 begin 241 secondpass(left); 242 if codegenerror then 243 exit; 244 245 { Explicit typecasts from any ordinal type to a boolean type } 246 { must not change the ordinal value } 247 if (nf_explicit in flags) and 248 not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) then 249 begin 250 location_copy(location,left.location); 251 newsize:=def_cgsize(resultdef); 252 { change of size? change sign only if location is LOC_(C)REGISTER? Then we have to sign/zero-extend } 253 if (tcgsize2size[newsize]<>tcgsize2size[left.location.size]) or 254 ((newsize<>left.location.size) and (location.loc in [LOC_REGISTER,LOC_CREGISTER])) then 255 hlcg.location_force_reg(current_asmdata.CurrAsmList,location,left.resultdef,resultdef,true) 256 else 257 location.size:=newsize; 258 exit; 259 end; 260 261 location_reset(location,LOC_REGISTER,def_cgsize(resultdef)); 262 opsize:=def_cgsize(left.resultdef); 263 264 if (left.location.loc in [LOC_SUBSETREG,LOC_CSUBSETREG,LOC_SUBSETREF,LOC_CSUBSETREF]) then 265 hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true); 266 267 case left.location.loc of 268 LOC_CREFERENCE,LOC_REFERENCE,LOC_REGISTER,LOC_CREGISTER: 269 begin 270 if left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE] then 271 begin 272 hreg2:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); 273 {$ifndef cpu64bitalu} 274 if left.location.size in [OS_64,OS_S64] then 275 begin 276 cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,left.location.reference,hreg2); 277 hreg1:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); 278 href:=left.location.reference; 279 inc(href.offset,4); 280 cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,href,hreg1); 281 cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_32,hreg1,hreg2,hreg2); 282 end 283 else 284 {$endif not cpu64bitalu} 285 cg.a_load_ref_reg(current_asmdata.CurrAsmList,opsize,opsize,left.location.reference,hreg2); 286 end 287 else 288 begin 289 hreg2:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); 290 {$ifndef cpu64bitalu} 291 if left.location.size in [OS_64,OS_S64] then 292 begin 293 hreg2:=cg.getintregister(current_asmdata.CurrAsmList,OS_32); 294 cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_32,left.location.register64.reghi,left.location.register64.reglo,hreg2); 295 end 296 else 297 {$endif not cpu64bitalu} 298 cg.a_load_reg_reg(current_asmdata.CurrAsmList,opsize,opsize,left.location.register,hreg2); 299 end; 300 hreg1:=cg.getintregister(current_asmdata.CurrAsmList,opsize); 301 {$ifdef cpu64bitalu} 302 { there are no ADDC/SUBC instructions working on xcc, i.e. the 64 bit flags } 303 if left.location.size in [OS_64,OS_S64] then 304 begin 305 if current_settings.cputype in [cpu_SPARC_V9] then 306 begin 307 current_asmdata.CurrAsmList.Concat(taicpu.op_reg_const_reg(A_MOVRZ,hreg2,0,hreg1)); 308 if is_pasbool(resultdef) then 309 current_asmdata.CurrAsmList.Concat(taicpu.op_reg_const_reg(A_MOVRNZ,hreg2,1,hreg1)) 310 else 311 current_asmdata.CurrAsmList.Concat(taicpu.op_reg_const_reg(A_MOVRNZ,hreg2,-1,hreg1)); 312 end 313 else 314 Internalerror(2017072101); 315 end 316 else 317 {$endif cpu64bitalu} 318 begin 319 current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUBCC,NR_G0,hreg2,NR_G0)); 320 if is_pasbool(resultdef) then 321 current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_ADDX,NR_G0,NR_G0,hreg1)) 322 else 323 current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUBX,NR_G0,NR_G0,hreg1)); 324 end; 325 end; 326 LOC_FLAGS : 327 begin 328 hreg1:=cg.GetIntRegister(current_asmdata.CurrAsmList,location.size); 329 resflags:=left.location.resflags; 330 cg.g_flags2reg(current_asmdata.CurrAsmList,location.size,resflags,hreg1); 331 if (is_cbool(resultdef)) then 332 cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NEG,location.size,hreg1,hreg1); 333 end; 334 LOC_JUMP : 335 begin 336 hreg1:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); 337 current_asmdata.getjumplabel(hlabel); 338 cg.a_label(current_asmdata.CurrAsmList,left.location.truelabel); 339 if not(is_cbool(resultdef)) then 340 cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,1,hreg1) 341 else 342 cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,-1,hreg1); 343 cg.a_jmp_always(current_asmdata.CurrAsmList,hlabel); 344 cg.a_label(current_asmdata.CurrAsmList,left.location.falselabel); 345 cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,0,hreg1); 346 cg.a_label(current_asmdata.CurrAsmList,hlabel); 347 end; 348 else 349 internalerror(10062); 350 end; 351 {$ifndef cpu64bitalu} 352 if (location.size in [OS_64,OS_S64]) then 353 begin 354 location.register64.reglo:=hreg1; 355 location.register64.reghi:=cg.getintregister(current_asmdata.CurrAsmList,OS_32); 356 if (is_cbool(resultdef)) then 357 { reglo is either 0 or -1 -> reghi has to become the same } 358 cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_32,OS_32,location.register64.reglo,location.register64.reghi) 359 else 360 { unsigned } 361 cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_32,0,location.register64.reghi); 362 end 363 else 364 {$endif not cpu64bitalu} 365 location.register:=hreg1; 366 end; 367 368 369 begin 370 ctypeconvnode:=tsparctypeconvnode; 371 end. 372