1 { 2 Copyright (c) 1998-2011 by Florian Klaempfl and Jonas Maebe 3 4 Generate assembler for constant nodes for the JVM 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 njvmcon; 23 24 {$i fpcdefs.inc} 25 26 interface 27 28 uses 29 globtype,aasmbase, 30 symtype, 31 node,ncal,ncon,ncgcon; 32 33 type 34 tjvmordconstnode = class(tcgordconstnode) 35 { normally, we convert the enum constant into a load of the 36 appropriate enum class field in pass_1. In some cases (array index), 37 we want to keep it as an enum constant however } 38 enumconstok: boolean; pass_1null39 function pass_1: tnode; override; docomparenull40 function docompare(p: tnode): boolean; override; dogetcopynull41 function dogetcopy: tnode; override; 42 end; 43 44 tjvmrealconstnode = class(tcgrealconstnode) 45 procedure pass_generate_code;override; 46 end; 47 48 tjvmstringconstnode = class(tstringconstnode) pass_1null49 function pass_1: tnode; override; 50 procedure pass_generate_code;override; emptydynstrnilnull51 class function emptydynstrnil: boolean; override; 52 end; 53 54 tjvmsetconsttype = ( 55 { create symbol for the set constant; the symbol will be initialized 56 in the class constructor/unit init code (default) } 57 sct_constsymbol, 58 { normally, we convert the set constant into a constructor/factory 59 method to create a set instance. In some cases (simple "in" 60 expressions, adding an element to an empty set, ...) we want to 61 keep the set constant instead } 62 sct_notransform, 63 { actually construct a JUBitSet/JUEnumSet that contains the set value 64 (for initializing the sets contstants) } 65 sct_construct 66 ); 67 tjvmsetconstnode = class(tcgsetconstnode) 68 setconsttype: tjvmsetconsttype; pass_1null69 function pass_1: tnode; override; 70 procedure pass_generate_code; override; 71 constructor create(s : pconstset;def:tdef);override; docomparenull72 function docompare(p: tnode): boolean; override; dogetcopynull73 function dogetcopy: tnode; override; 74 protected emitvarsetconstnull75 function emitvarsetconst: tasmsymbol; override; 76 { in case the set has only a single run of consecutive elements, 77 this function will return its starting index and length } find_single_elements_runnull78 function find_single_elements_run(from: longint; out start, len: longint): boolean; buildbitsetnull79 function buildbitset: tnode; buildenumsetnull80 function buildenumset(const eledef: tdef): tnode; buildsetfromstringnull81 function buildsetfromstring(const helpername: string; otherparas: tcallparanode): tnode; 82 end; 83 84 85 implementation 86 87 uses 88 globals,cutils,widestr,verbose,constexp,fmodule, 89 symdef,symsym,symcpu,symtable,symconst, 90 aasmdata,aasmcpu,defutil, 91 nutils,ncnv,nld,nmem,pjvm,pass_1, 92 cgbase,hlcgobj,hlcgcpu,cgutils,cpubase 93 ; 94 95 96 {***************************************************************************** 97 TJVMORDCONSTNODE 98 *****************************************************************************} 99 tjvmordconstnode.pass_1null100 function tjvmordconstnode.pass_1: tnode; 101 var 102 basedef: tcpuenumdef; 103 sym: tenumsym; 104 classfield: tsym; 105 begin 106 if (resultdef.typ<>enumdef) or 107 enumconstok then 108 begin 109 result:=inherited pass_1; 110 exit; 111 end; 112 { convert into JVM class instance } 113 { a) find the enumsym corresponding to the value (may not exist in case 114 of an explicit typecast of an integer -> error) } 115 sym:=nil; 116 sym:=tenumsym(tenumdef(resultdef).int2enumsym(int64(value))); 117 if not assigned(sym) then 118 begin 119 Message(parser_e_range_check_error); 120 result:=nil; 121 exit; 122 end; 123 { b) find the corresponding class field } 124 basedef:=tcpuenumdef(tenumdef(resultdef).getbasedef); 125 classfield:=search_struct_member(basedef.classdef,sym.name); 126 127 { c) create loadnode of the field } 128 result:=nil; 129 if not handle_staticfield_access(classfield,result) then 130 internalerror(2011062606); 131 end; 132 133 tjvmordconstnode.docomparenull134 function tjvmordconstnode.docompare(p: tnode): boolean; 135 begin 136 result:=inherited docompare(p); 137 if result then 138 result:=(enumconstok=tjvmordconstnode(p).enumconstok); 139 end; 140 141 tjvmordconstnode.dogetcopynull142 function tjvmordconstnode.dogetcopy: tnode; 143 begin 144 result:=inherited dogetcopy; 145 tjvmordconstnode(result).enumconstok:=enumconstok; 146 end; 147 148 149 {***************************************************************************** 150 TJVMREALCONSTNODE 151 *****************************************************************************} 152 153 procedure tjvmrealconstnode.pass_generate_code; 154 begin 155 location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef)); 156 location.register:=hlcg.getfpuregister(current_asmdata.CurrAsmList,resultdef); 157 thlcgjvm(hlcg).a_loadfpu_const_stack(current_asmdata.CurrAsmList,resultdef,value_real); 158 thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,resultdef,location.register); 159 end; 160 161 162 { tcgstringconstnode } 163 tjvmstringconstnode.pass_1null164 function tjvmstringconstnode.pass_1: tnode; 165 var 166 strclass: tobjectdef; 167 pw: pcompilerwidestring; 168 paras: tcallparanode; 169 wasansi: boolean; 170 begin 171 { all Java strings are utf-16. However, there is no way to 172 declare a constant array of bytes (or any other type), those 173 have to be constructed by declaring a final field and then 174 initialising them in the class constructor element per 175 element. We therefore put the straight ASCII values into 176 the UTF-16 string, and then at run time extract those and 177 store them in an Ansistring/AnsiChar array } 178 result:=inherited pass_1; 179 if assigned(result) or 180 (cst_type in [cst_unicodestring,cst_widestring]) then 181 exit; 182 { convert the constant into a widestring representation without any 183 code page conversion } 184 initwidestring(pw); 185 ascii2unicode(value_str,len,current_settings.sourcecodepage,pw,false); 186 ansistringdispose(value_str,len); 187 pcompilerwidestring(value_str):=pw; 188 { and now add a node to convert the data into ansistring format at 189 run time } 190 wasansi:=false; 191 case cst_type of 192 cst_ansistring: 193 begin 194 if len=0 then 195 begin 196 { we have to use nil rather than an empty string, because an 197 empty string has a code page and this messes up the code 198 page selection logic in the RTL } 199 exit; 200 end; 201 strclass:=tobjectdef(search_system_type('ANSISTRINGCLASS').typedef); 202 wasansi:=true; 203 end; 204 cst_shortstring: 205 strclass:=tobjectdef(search_system_type('SHORTSTRINGCLASS').typedef); 206 cst_conststring: 207 { used for array of char } 208 strclass:=tobjectdef(search_system_type('ANSICHARARRAYCLASS').typedef); 209 else 210 internalerror(2011052401); 211 end; 212 cst_type:=cst_unicodestring; 213 paras:=ccallparanode.create(self.getcopy,nil); 214 if wasansi then 215 paras:=ccallparanode.create( 216 genintconstnode(tstringdef(resultdef).encoding),paras); 217 { since self will be freed, have to make a copy } 218 result:=ccallnode.createinternmethodres( 219 cloadvmtaddrnode.create(ctypenode.create(strclass)), 220 'CREATEFROMLITERALSTRINGBYTES',paras,resultdef); 221 end; 222 223 224 procedure tjvmstringconstnode.pass_generate_code; 225 begin 226 location_reset(location,LOC_REGISTER,def_cgsize(resultdef)); 227 location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef); 228 case cst_type of 229 cst_ansistring: 230 begin 231 if len<>0 then 232 internalerror(2012052604); 233 hlcg.a_load_const_reg(current_asmdata.CurrAsmList,resultdef,0,location.register); 234 { done } 235 exit; 236 end; 237 cst_shortstring, 238 cst_conststring: 239 internalerror(2012052601); 240 cst_unicodestring, 241 cst_widestring: 242 current_asmdata.CurrAsmList.concat(taicpu.op_wstring(a_ldc,pcompilerwidestring(value_str))); 243 else 244 internalerror(2012052602); 245 end; 246 thlcgjvm(hlcg).incstack(current_asmdata.CurrAsmList,1); 247 thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,resultdef,location.register); 248 end; 249 tjvmstringconstnode.emptydynstrnilnull250 class function tjvmstringconstnode.emptydynstrnil: boolean; 251 begin 252 result:=false; 253 end; 254 255 256 {***************************************************************************** 257 TJVMSETCONSTNODE 258 *****************************************************************************} 259 tjvmsetconstnode.buildsetfromstringnull260 function tjvmsetconstnode.buildsetfromstring(const helpername: string; otherparas: tcallparanode): tnode; 261 var 262 pw: pcompilerwidestring; 263 wc: tcompilerwidechar; 264 i, j, bit, nulls: longint; 265 begin 266 initwidestring(pw); 267 nulls:=0; 268 for i:=0 to 15 do 269 begin 270 wc:=0; 271 for bit:=0 to 15 do 272 if (i*16+bit) in value_set^ then 273 wc:=wc or (1 shl (15-bit)); 274 { don't add trailing zeroes } 275 if wc=0 then 276 inc(nulls) 277 else 278 begin 279 for j:=1 to nulls do 280 concatwidestringchar(pw,0); 281 nulls:=0; 282 concatwidestringchar(pw,wc); 283 end; 284 end; 285 result:=ccallnode.createintern(helpername, 286 ccallparanode.create(cstringconstnode.createunistr(pw),otherparas)); 287 donewidestring(pw); 288 end; 289 290 tjvmsetconstnode.buildbitsetnull291 function tjvmsetconstnode.buildbitset: tnode; 292 var 293 mp: tnode; 294 begin 295 if value_set^=[] then 296 begin 297 mp:=cloadvmtaddrnode.create(ctypenode.create(java_jubitset)); 298 result:=ccallnode.createinternmethod(mp,'CREATE',nil); 299 exit; 300 end; 301 result:=buildsetfromstring('fpc_bitset_from_string',nil); 302 end; 303 304 tjvmsetconstnode.buildenumsetnull305 function tjvmsetconstnode.buildenumset(const eledef: tdef): tnode; 306 var 307 stopnode: tnode; 308 startnode: tnode; 309 mp: tnode; 310 len: longint; 311 start: longint; 312 enumele: tnode; 313 paras: tcallparanode; 314 hassinglerun: boolean; 315 begin 316 hassinglerun:=find_single_elements_run(0, start, len); 317 if hassinglerun then 318 begin 319 mp:=cloadvmtaddrnode.create(ctypenode.create(java_juenumset)); 320 if len=0 then 321 begin 322 enumele:=cloadvmtaddrnode.create(ctypenode.create(tcpuenumdef(tenumdef(eledef).getbasedef).classdef)); 323 inserttypeconv_explicit(enumele,search_system_type('JLCLASS').typedef); 324 paras:=ccallparanode.create(enumele,nil); 325 result:=ccallnode.createinternmethod(mp,'NONEOF',paras) 326 end 327 else 328 begin 329 startnode:=cordconstnode.create(start,eledef,false); 330 { immediately firstpass so the enum gets translated into a JLEnum 331 instance } 332 firstpass(startnode); 333 if len=1 then 334 result:=ccallnode.createinternmethod(mp,'OF',ccallparanode.create(startnode,nil)) 335 else 336 begin 337 stopnode:=cordconstnode.create(start+len-1,eledef,false); 338 firstpass(stopnode); 339 result:=ccallnode.createinternmethod(mp,'RANGE',ccallparanode.create(stopnode,ccallparanode.create(startnode,nil))); 340 end 341 end 342 end 343 else 344 begin 345 enumele:=cordconstnode.create(tenumsym(tenumdef(eledef).symtable.symlist[0]).value,eledef,false); 346 firstpass(enumele); 347 paras:=ccallparanode.create(enumele,nil); 348 result:=buildsetfromstring('fpc_enumset_from_string',paras); 349 end; 350 end; 351 352 tjvmsetconstnode.pass_1null353 function tjvmsetconstnode.pass_1: tnode; 354 var 355 eledef: tdef; 356 begin 357 { we want set constants to be global, so we can reuse them. However, 358 if the set's elementdef is local, we can't do that since a global 359 symbol cannot have a local definition (the compiler will crash when 360 loading the ppu file afterwards) } 361 if tsetdef(resultdef).elementdef.owner.symtabletype=localsymtable then 362 setconsttype:=sct_construct; 363 result:=nil; 364 case setconsttype of 365 (* 366 sct_constsymbol: 367 begin 368 { normally a codegen pass routine, but we have to insert a typed 369 const in case the set constant does not exist yet, and that 370 should happen in pass_1 (especially since it involves creating 371 new nodes, which may even have to be tacked on to this code in 372 case it's the unit initialization code) } 373 handlevarsetconst; 374 { no smallsets } 375 expectloc:=LOC_CREFERENCE; 376 end; 377 *) 378 sct_notransform: 379 begin 380 result:=inherited pass_1; 381 { no smallsets } 382 expectloc:=LOC_CREFERENCE; 383 end; 384 sct_constsymbol, 385 sct_construct: 386 begin 387 eledef:=tsetdef(resultdef).elementdef; 388 { empty sets don't have an element type, so we don't know whether we 389 have to constructor a bitset or enumset (and of which type) } 390 if not assigned(eledef) then 391 internalerror(2011070202); 392 if eledef.typ=enumdef then 393 begin 394 result:=buildenumset(eledef); 395 end 396 else 397 begin 398 result:=buildbitset; 399 end; 400 inserttypeconv_explicit(result,cpointerdef.getreusable(resultdef)); 401 result:=cderefnode.create(result); 402 end; 403 else 404 internalerror(2011060301); 405 end; 406 end; 407 408 409 procedure tjvmsetconstnode.pass_generate_code; 410 begin 411 case setconsttype of 412 sct_constsymbol: 413 begin 414 { all sets are varsets for the JVM target, no setbase differences } 415 handlevarsetconst; 416 end; 417 else 418 { must be handled in pass_1 or otherwise transformed } 419 internalerror(2011070201) 420 end; 421 end; 422 423 constructor tjvmsetconstnode.create(s: pconstset; def: tdef); 424 begin 425 inherited create(s, def); 426 setconsttype:=sct_constsymbol; 427 end; 428 429 tjvmsetconstnode.docomparenull430 function tjvmsetconstnode.docompare(p: tnode): boolean; 431 begin 432 result:= 433 inherited docompare(p) and 434 (setconsttype=tjvmsetconstnode(p).setconsttype); 435 end; 436 437 tjvmsetconstnode.dogetcopynull438 function tjvmsetconstnode.dogetcopy: tnode; 439 begin 440 result:=inherited dogetcopy; 441 tjvmsetconstnode(result).setconsttype:=setconsttype; 442 end; 443 444 tjvmsetconstnode.emitvarsetconstnull445 function tjvmsetconstnode.emitvarsetconst: tasmsymbol; 446 var 447 csym: tconstsym; 448 ssym: tstaticvarsym; 449 ps: pnormalset; 450 begin 451 { add a read-only typed constant } 452 new(ps); 453 ps^:=value_set^; 454 csym:=cconstsym.create_ptr('_$setconst'+tostr(current_module.symlist.count),constset,ps,resultdef); 455 csym.visibility:=vis_private; 456 include(csym.symoptions,sp_internal); 457 current_module.localsymtable.insert(csym); 458 { generate assignment of the constant to the typed constant symbol } 459 ssym:=jvm_add_typed_const_initializer(csym); 460 result:=current_asmdata.RefAsmSymbol(ssym.mangledname,AT_DATA); 461 end; 462 463 tjvmsetconstnode.find_single_elements_runnull464 function tjvmsetconstnode.find_single_elements_run(from: longint; out start, len: longint): boolean; 465 var 466 i: longint; 467 begin 468 i:=from; 469 result:=true; 470 { find first element in set } 471 while (i<=255) and 472 not(i in value_set^) do 473 inc(i); 474 start:=i; 475 { go to end of the run } 476 while (i<=255) and 477 (i in value_set^) do 478 inc(i); 479 len:=i-start; 480 { rest must be unset } 481 while (i<=255) and 482 not(i in value_set^) do 483 inc(i); 484 if i<>256 then 485 result:=false; 486 end; 487 488 489 490 begin 491 cordconstnode:=tjvmordconstnode; 492 crealconstnode:=tjvmrealconstnode; 493 cstringconstnode:=tjvmstringconstnode; 494 csetconstnode:=tjvmsetconstnode; 495 end. 496