1 { 2 Copyright (c) 2011 by Jonas Maebe 3 4 Generate JVM byetcode for in memory related 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 njvmmem; 23 24 {$i fpcdefs.inc} 25 26 interface 27 28 uses 29 globtype, 30 cgbase,cpubase, 31 node,nmem,ncgmem,ncgnstmm; 32 33 type 34 tjvmaddrnode = class(tcgaddrnode) 35 protected isrefparaloadnull36 function isrefparaload: boolean; isarrayele0loadnull37 function isarrayele0load: boolean; isdererencenull38 function isdererence: boolean; 39 public pass_typechecknull40 function pass_typecheck: tnode; override; 41 procedure pass_generate_code; override; 42 end; 43 44 tjvmderefnode = class(tcgderefnode) pass_typechecknull45 function pass_typecheck: tnode; override; 46 procedure pass_generate_code; override; 47 end; 48 49 tjvmsubscriptnode = class(tcgsubscriptnode) 50 protected handle_platform_subscriptnull51 function handle_platform_subscript: boolean; override; 52 end; 53 54 tjvmloadvmtaddrnode = class(tcgloadvmtaddrnode) pass_1null55 function pass_1: tnode; override; 56 procedure pass_generate_code; override; 57 end; 58 59 tjvmvecnode = class(tcgvecnode) 60 protected gen_array_rangechecknull61 function gen_array_rangecheck: tnode; override; 62 public pass_1null63 function pass_1: tnode; override; 64 procedure pass_generate_code;override; 65 end; 66 67 implementation 68 69 uses 70 systems,globals,procinfo, 71 cutils,verbose,constexp, 72 aasmbase, 73 symconst,symtype,symtable,symsym,symdef,symcpu,defutil,jvmdef, 74 htypechk,paramgr, 75 nadd,ncal,ncnv,ncon,nld,nutils, 76 pass_1,njvmcon, 77 aasmdata,aasmcpu,pass_2, 78 cgutils,hlcgobj,hlcgcpu; 79 80 {***************************************************************************** 81 TJVMDEREFNODE 82 *****************************************************************************} 83 tjvmderefnode.pass_typechecknull84 function tjvmderefnode.pass_typecheck: tnode; 85 begin 86 result:=inherited pass_typecheck; 87 if assigned(result) then 88 exit; 89 { don't allow dereferencing untyped pointers, because how this has to 90 be done depends on whether it's a pointer to an implicit pointer type 91 or not } 92 if is_voidpointer(left.resultdef) then 93 CGMessage(parser_e_illegal_expression); 94 end; 95 96 97 procedure tjvmderefnode.pass_generate_code; 98 var 99 implicitptr: boolean; 100 begin 101 secondpass(left); 102 implicitptr:=jvmimplicitpointertype(resultdef); 103 if implicitptr then 104 begin 105 { this is basically a typecast: the left node is a regular 106 'pointer', and we typecast it to an implicit pointer } 107 location_copy(location,left.location); 108 { these implicit pointer types (records, sets, shortstrings, ...) 109 cannot be located in registers on native targets (since 110 they're not pointers there) -> force into memory to avoid 111 confusing the compiler; this can happen when typecasting a 112 Java class type into a pshortstring and then dereferencing etc 113 } 114 if location.loc in [LOC_REGISTER,LOC_CREGISTER] then 115 hlcg.location_force_mem(current_asmdata.CurrAsmList,location,left.resultdef); 116 end 117 else 118 begin 119 { these are always arrays (used internally for pointers to var 120 parameters stored in nestedfpstructs, and by programmers for any 121 kind of pointers) } 122 hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true); 123 location_reset_ref(location,LOC_REFERENCE,def_cgsize(resultdef),4,[]); 124 reference_reset_base(location.reference,left.location.register,0,ctempposinvalid,4,[]); 125 location.reference.arrayreftype:=art_indexconst; 126 if (left.nodetype<>addrn) and 127 not(resultdef.typ in [orddef,floatdef]) and 128 not is_voidpointer(resultdef) and 129 ((resultdef.typ<>objectdef) or 130 (find_real_class_definition(tobjectdef(resultdef),false)<>java_jlobject)) then 131 location.reference.checkcast:=true; 132 end 133 end; 134 135 136 {***************************************************************************** 137 TJVMSUBSCRIPTNODE 138 *****************************************************************************} 139 tjvmsubscriptnode.handle_platform_subscriptnull140 function tjvmsubscriptnode.handle_platform_subscript: boolean; 141 begin 142 result:=false; 143 if is_java_class_or_interface(left.resultdef) or 144 (left.resultdef.typ=recorddef) then 145 begin 146 if (location.loc<>LOC_REFERENCE) or 147 (location.reference.index<>NR_NO) or 148 assigned(location.reference.symbol) then 149 internalerror(2011011301); 150 location.reference.symbol:=current_asmdata.RefAsmSymbol(vs.mangledname,AT_METADATA); 151 result:=true; 152 end 153 end; 154 155 156 {***************************************************************************** 157 TJVMADDRNODE 158 *****************************************************************************} 159 tjvmaddrnode.isrefparaloadnull160 function tjvmaddrnode.isrefparaload: boolean; 161 begin 162 result:= 163 (left.nodetype=loadn) and 164 (tloadnode(left).symtableentry.typ=paravarsym) and 165 paramanager.push_copyout_param(tparavarsym(tloadnode(left).symtableentry).varspez, 166 left.resultdef, 167 tabstractprocdef(tloadnode(left).symtableentry.owner.defowner).proccalloption); 168 end; 169 170 tjvmaddrnode.isarrayele0loadnull171 function tjvmaddrnode.isarrayele0load: boolean; 172 begin 173 result:= 174 (left.nodetype=vecn) and 175 (tvecnode(left).left.resultdef.typ=arraydef) and 176 (tvecnode(left).right.nodetype=ordconstn) and 177 (tordconstnode(tvecnode(left).right).value=tarraydef(tvecnode(left).left.resultdef).lowrange); 178 end; 179 180 tjvmaddrnode.isdererencenull181 function tjvmaddrnode.isdererence: boolean; 182 var 183 target: tnode; 184 begin 185 target:=actualtargetnode(@left)^; 186 result:= 187 (left.nodetype=derefn); 188 end; 189 190 tjvmaddrnode.pass_typechecknull191 function tjvmaddrnode.pass_typecheck: tnode; 192 var 193 fsym: tsym; 194 begin 195 result:=nil; 196 typecheckpass(left); 197 if codegenerror then 198 exit; 199 200 make_not_regable(left,[ra_addr_regable,ra_addr_taken]); 201 202 { in TP/Delphi, @procvar = contents of procvar and @@procvar = 203 address of procvar. In case of a procedure of object, this works 204 by letting the first addrnode typecast the procvar into a tmethod 205 record followed by subscripting its "code" field (= first field), 206 and if there's a second addrnode then it takes the address of 207 this code field (which is hence also the address of the procvar). 208 209 In Java, such ugly hacks don't work -> replace first addrnode 210 with getting procvar.method.code, and second addrnode with 211 the class for procedure of object} 212 if not(nf_internal in flags) and 213 ((m_tp_procvar in current_settings.modeswitches) or 214 (m_mac_procvar in current_settings.modeswitches)) and 215 (((left.nodetype=addrn) and 216 (taddrnode(left).left.resultdef.typ=procvardef)) or 217 (left.resultdef.typ=procvardef)) then 218 begin 219 if (left.nodetype=addrn) and 220 (taddrnode(left).left.resultdef.typ=procvardef) then 221 begin 222 { double address -> pointer that is the address of the 223 procvardef (don't allow for non-object procvars, as they 224 aren't implicitpointerdefs) } 225 if not jvmimplicitpointertype(taddrnode(left).left.resultdef) then 226 CGMessage(parser_e_illegal_expression) 227 else 228 begin 229 { an internal address node will observe "normal" address 230 operator semantics (= take the actual address!) } 231 result:=caddrnode.create_internal(taddrnode(left).left); 232 result:=ctypeconvnode.create_explicit(result,tcpuprocvardef(taddrnode(left).left.resultdef).classdef); 233 taddrnode(left).left:=nil; 234 end; 235 end 236 else if left.resultdef.typ=procvardef then 237 begin 238 if not tprocvardef(left.resultdef).is_addressonly then 239 begin 240 { the "code" field from the procvar } 241 result:=caddrnode.create_internal(left); 242 result:=ctypeconvnode.create_explicit(result,tcpuprocvardef(left.resultdef).classdef); 243 { procvarclass.method } 244 fsym:=search_struct_member(tcpuprocvardef(left.resultdef).classdef,'METHOD'); 245 if not assigned(fsym) or 246 (fsym.typ<>fieldvarsym) then 247 internalerror(2011072501); 248 result:=csubscriptnode.create(fsym,result); 249 { procvarclass.method.code } 250 fsym:=search_struct_member(trecorddef(tfieldvarsym(fsym).vardef),'CODE'); 251 if not assigned(fsym) or 252 (fsym.typ<>fieldvarsym) then 253 internalerror(2011072502); 254 result:=csubscriptnode.create(fsym,result); 255 left:=nil 256 end 257 else 258 { convert contents to plain pointer } 259 begin 260 result:=ctypeconvnode.create_explicit(left,java_jlobject); 261 include(result.flags,nf_load_procvar); 262 left:=nil; 263 end; 264 end 265 else 266 internalerror(2011072506); 267 end 268 else if (left.resultdef.typ=procdef) then 269 begin 270 result:=inherited; 271 exit; 272 end 273 else 274 begin 275 if not jvmimplicitpointertype(left.resultdef) then 276 begin 277 { allow taking the address of a copy-out parameter (it's an 278 array reference), of the first element of an array and of a 279 pointer derefence } 280 if not isrefparaload and 281 not isarrayele0load and 282 not isdererence then 283 begin 284 CGMessage(parser_e_illegal_expression); 285 exit 286 end; 287 end; 288 result:=inherited; 289 end; 290 end; 291 292 293 procedure tjvmaddrnode.pass_generate_code; 294 var 295 implicitptr: boolean; 296 begin 297 secondpass(left); 298 implicitptr:=jvmimplicitpointertype(left.resultdef); 299 if implicitptr then 300 { this is basically a typecast: the left node is an implicit 301 pointer, and we typecast it to a regular 'pointer' 302 (java.lang.Object) } 303 location_copy(location,left.location) 304 else 305 begin 306 { these are always arrays (used internally for pointers to var 307 parameters stored in nestedfpstructs) -> get base pointer to 308 array } 309 if (left.location.loc<>LOC_REFERENCE) or 310 (left.location.reference.arrayreftype<>art_indexconst) or 311 (left.location.reference.base=NR_NO) or 312 (left.location.reference.indexoffset<>0) or 313 assigned(left.location.reference.symbol) then 314 internalerror(2011060701); 315 location_reset(location,LOC_REGISTER,OS_ADDR); 316 location.register:=left.location.reference.base; 317 end; 318 end; 319 320 {***************************************************************************** 321 TJVMLOADVMTADDRNODE 322 *****************************************************************************} 323 tjvmloadvmtaddrnode.pass_1null324 function tjvmloadvmtaddrnode.pass_1: tnode; 325 var 326 vs: tsym; 327 begin 328 result:=nil; 329 if is_javaclass(left.resultdef) and 330 (left.nodetype<>typen) and 331 (left.resultdef.typ<>classrefdef) then 332 begin 333 { call java.lang.Object.getClass() } 334 vs:=search_struct_member(tobjectdef(left.resultdef),'GETCLASS'); 335 if not assigned(vs) or 336 (tsym(vs).typ<>procsym) then 337 internalerror(2011041901); 338 result:=ccallnode.create(nil,tprocsym(vs),vs.owner,left,[],nil); 339 inserttypeconv_explicit(result,resultdef); 340 { reused } 341 left:=nil; 342 end; 343 end; 344 345 346 procedure tjvmloadvmtaddrnode.pass_generate_code; 347 begin 348 current_asmdata.CurrAsmList.concat(taicpu.op_sym(a_ldc,current_asmdata.RefAsmSymbol( 349 tabstractrecorddef(tclassrefdef(resultdef).pointeddef).jvm_full_typename(true),AT_METADATA))); 350 thlcgjvm(hlcg).incstack(current_asmdata.CurrAsmList,1); 351 location_reset(location,LOC_REGISTER,OS_ADDR); 352 location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef); 353 thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,resultdef,location.register); 354 end; 355 356 357 {***************************************************************************** 358 TJVMVECNODE 359 *****************************************************************************} 360 tjvmvecnode.gen_array_rangechecknull361 function tjvmvecnode.gen_array_rangecheck: tnode; 362 begin 363 { JVM does the range checking for us } 364 result:=nil; 365 end; 366 367 tjvmvecnode.pass_1null368 function tjvmvecnode.pass_1: tnode; 369 var 370 psym: tsym; 371 stringclass: tdef; 372 begin 373 if (left.resultdef.typ=stringdef) then 374 begin 375 case tstringdef(left.resultdef).stringtype of 376 st_ansistring: 377 stringclass:=java_ansistring; 378 st_unicodestring, 379 st_widestring: 380 stringclass:=java_jlstring; 381 st_shortstring: 382 begin 383 stringclass:=java_shortstring; 384 left:=caddrnode.create_internal(left); 385 { avoid useless typecheck when casting to shortstringclass } 386 include(taddrnode(left).addrnodeflags,anf_typedaddr); 387 end 388 else 389 internalerror(2011052407); 390 end; 391 psym:=search_struct_member(tabstractrecorddef(stringclass),'CHARAT'); 392 if not assigned(psym) or 393 (psym.typ<>procsym) then 394 internalerror(2011031501); 395 { Pascal strings are 1-based, Java strings 0-based } 396 result:=ccallnode.create(ccallparanode.create( 397 caddnode.create(subn,right,genintconstnode(1)),nil),tprocsym(psym), 398 psym.owner,ctypeconvnode.create_explicit(left,stringclass),[],nil); 399 left:=nil; 400 right:=nil; 401 exit; 402 end 403 else 404 begin 405 { keep indices that are enum constants that way, rather than 406 transforming them into a load of the class instance that 407 represents this constant (since we then would have to extract 408 the int constant value again at run time anyway) } 409 if right.nodetype=ordconstn then 410 tjvmordconstnode(right).enumconstok:=true; 411 result:=inherited; 412 end; 413 end; 414 415 416 procedure tjvmvecnode.pass_generate_code; 417 var 418 psym: tsym; 419 newsize: tcgsize; 420 begin 421 if left.resultdef.typ=stringdef then 422 internalerror(2011052702); 423 424 { This routine is not used for Strings, as they are a class type and 425 you have to use charAt() there to load a character (and you cannot 426 change characters; you have to create a new string in that case) 427 428 As far as arrays are concerned: we have to create a trefererence 429 with arrayreftype in [art_indexreg,art_indexref], and ref.base = 430 pointer to the array (i.e., left.location.register) } 431 secondpass(left); 432 newsize:=def_cgsize(resultdef); 433 if left.location.loc=LOC_CREFERENCE then 434 location_reset_ref(location,LOC_CREFERENCE,newsize,left.location.reference.alignment,left.location.reference.volatility) 435 else 436 location_reset_ref(location,LOC_REFERENCE,newsize,left.location.reference.alignment,left.location.reference.volatility); 437 { don't use left.resultdef, because it may be an open or regular array, 438 and then asking for the size doesn't make any sense } 439 hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,java_jlobject,java_jlobject,true); 440 location.reference.base:=left.location.register; 441 secondpass(right); 442 if (right.expectloc=LOC_JUMP)<> 443 (right.location.loc=LOC_JUMP) then 444 internalerror(2011090501); 445 446 { simplify index location if necessary, since array references support 447 an index in memory, but not an another array index } 448 if (right.location.loc=LOC_JUMP) or 449 ((right.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and 450 (right.location.reference.arrayreftype<>art_none)) then 451 hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,right.resultdef,true); 452 453 { replace enum class instance with the corresponding integer value } 454 if (right.resultdef.typ=enumdef) then 455 begin 456 if (right.location.loc<>LOC_CONSTANT) then 457 begin 458 psym:=search_struct_member(tcpuenumdef(tenumdef(right.resultdef).getbasedef).classdef,'FPCORDINAL'); 459 if not assigned(psym) or 460 (psym.typ<>procsym) or 461 (tprocsym(psym).ProcdefList.count<>1) then 462 internalerror(2011062607); 463 thlcgjvm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,right.resultdef,right.location); 464 hlcg.a_call_name(current_asmdata.CurrAsmList,tprocdef(tprocsym(psym).procdeflist[0]),tprocdef(tprocsym(psym).procdeflist[0]).mangledname,[],nil,false); 465 { call replaces self parameter with longint result -> no stack 466 height change } 467 location_reset(right.location,LOC_REGISTER,OS_S32); 468 right.location.register:=hlcg.getintregister(current_asmdata.CurrAsmList,s32inttype); 469 thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,s32inttype,right.location.register); 470 end; 471 { always force to integer location, because enums are handled as 472 object instances (since that's what they are in Java) } 473 right.resultdef:=s32inttype; 474 right.location.size:=OS_S32; 475 end 476 else if (right.location.loc<>LOC_CONSTANT) and 477 ((right.resultdef.typ<>orddef) or 478 (torddef(right.resultdef).ordtype<>s32bit)) then 479 begin 480 { Java array indices are always 32 bit signed integers } 481 hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,s32inttype,true); 482 right.resultdef:=s32inttype; 483 end; 484 485 { adjust index if necessary } 486 if not is_special_array(left.resultdef) and 487 (tarraydef(left.resultdef).lowrange<>0) and 488 (right.location.loc<>LOC_CONSTANT) then 489 begin 490 thlcgjvm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,right.resultdef,right.location); 491 thlcgjvm(hlcg).a_op_const_stack(current_asmdata.CurrAsmList,OP_SUB,right.resultdef,tarraydef(left.resultdef).lowrange); 492 location_reset(right.location,LOC_REGISTER,def_cgsize(right.resultdef)); 493 right.location.register:=hlcg.getintregister(current_asmdata.CurrAsmList,right.resultdef); 494 thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,right.resultdef,right.location.register); 495 end; 496 497 { create array reference } 498 case right.location.loc of 499 LOC_REGISTER,LOC_CREGISTER: 500 begin 501 location.reference.arrayreftype:=art_indexreg; 502 location.reference.index:=right.location.register; 503 end; 504 LOC_REFERENCE,LOC_CREFERENCE: 505 begin 506 location.reference.arrayreftype:=art_indexref; 507 location.reference.indexbase:=right.location.reference.base; 508 location.reference.indexsymbol:=right.location.reference.symbol; 509 location.reference.indexoffset:=right.location.reference.offset; 510 end; 511 LOC_CONSTANT: 512 begin 513 location.reference.arrayreftype:=art_indexconst; 514 location.reference.indexoffset:=right.location.value-tarraydef(left.resultdef).lowrange; 515 end 516 else 517 internalerror(2011012002); 518 end; 519 end; 520 521 522 begin 523 cderefnode:=tjvmderefnode; 524 csubscriptnode:=tjvmsubscriptnode; 525 caddrnode:=tjvmaddrnode; 526 cvecnode:=tjvmvecnode; 527 cloadvmtaddrnode:=tjvmloadvmtaddrnode; 528 end. 529