jvmdef.pas 35 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013
  1. {
  2. Copyright (c) 2010 by Jonas Maebe
  3. This unit implements some JVM type helper routines (minimal
  4. unit dependencies, usable in symdef).
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  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. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. {$i fpcdefs.inc}
  19. unit jvmdef;
  20. interface
  21. uses
  22. globtype,
  23. node,
  24. symbase,symtype;
  25. { returns whether a def can make use of an extra type signature (for
  26. Java-style generics annotations; not use for FPC-style generics or their
  27. translations, but to annotate the kind of classref a java.lang.Class is
  28. and things like that) }
  29. function jvmtypeneedssignature(def: tdef): boolean;
  30. { create a signature encoding of a particular type; requires that
  31. jvmtypeneedssignature returned "true" for this type }
  32. procedure jvmaddencodedsignature(def: tdef; bpacked: boolean; var encodedstr: TSymStr);
  33. { Encode a type into the internal format used by the JVM (descriptor).
  34. Returns false if a type is not representable by the JVM,
  35. and in that case also the failing definition. }
  36. function jvmtryencodetype(def: tdef; out encodedtype: TSymStr; forcesignature: boolean; out founderror: tdef): boolean;
  37. { same as above, but throws an internal error on failure }
  38. function jvmencodetype(def: tdef; withsignature: boolean): TSymStr;
  39. { Check whether a type can be used in a JVM methom signature or field
  40. declaration. }
  41. function jvmchecktype(def: tdef; out founderror: tdef): boolean;
  42. { incremental version of jvmtryencodetype() }
  43. function jvmaddencodedtype(def: tdef; bpacked: boolean; var encodedstr: TSymStr; forcesignature: boolean; out founderror: tdef): boolean;
  44. { add type prefix (package name) to a type }
  45. procedure jvmaddtypeownerprefix(owner: tsymtable; var name: TSymStr);
  46. { returns type string for a single-dimensional array (different from normal
  47. typestring in case of a primitive type) }
  48. function jvmarrtype(def: tdef; out primitivetype: boolean): TSymStr;
  49. function jvmarrtype_setlength(def: tdef): char;
  50. { returns whether a def is emulated using an implicit pointer type on the
  51. JVM target (e.g., records, regular arrays, ...) }
  52. function jvmimplicitpointertype(def: tdef): boolean;
  53. { returns the mangled base name for a tsym (type + symbol name, no
  54. visibility etc); also adds signature attribute if requested and
  55. appropriate }
  56. function jvmmangledbasename(sym: tsym; withsignature: boolean): TSymStr;
  57. function jvmmangledbasename(sym: tsym; const usesymname: TSymStr; withsignature: boolean): TSymStr;
  58. { sometimes primitive types have to be boxed/unboxed via class types. This
  59. routine returns the appropriate box type for the passed primitive type }
  60. procedure jvmgetboxtype(def: tdef; out objdef, paradef: tdef; mergeints: boolean);
  61. function jvmgetunboxmethod(def: tdef): string;
  62. function jvmgetcorrespondingclassdef(def: tdef): tdef;
  63. function get_para_push_size(def: tdef): tdef;
  64. { threadvars are wrapped via descendents of java.lang.ThreadLocal }
  65. function jvmgetthreadvardef(def: tdef): tdef;
  66. { gets the number of dimensions and the final element type of a normal
  67. array }
  68. procedure jvmgetarraydimdef(arrdef: tdef; out eledef: tdef; out ndim: longint);
  69. implementation
  70. uses
  71. cutils,cclasses,constexp,
  72. verbose,systems,
  73. fmodule,
  74. symtable,symconst,symsym,symdef,symcpu,symcreat,
  75. defutil,paramgr;
  76. {******************************************************************
  77. Type encoding
  78. *******************************************************************}
  79. function jvmtypeneedssignature(def: tdef): boolean;
  80. var
  81. i: longint;
  82. begin
  83. result:=false;
  84. case def.typ of
  85. classrefdef,
  86. setdef:
  87. begin
  88. result:=true;
  89. end;
  90. arraydef :
  91. begin
  92. result:=jvmtypeneedssignature(tarraydef(def).elementdef);
  93. end;
  94. procvardef :
  95. begin
  96. { may change in the future }
  97. end;
  98. procdef :
  99. begin
  100. for i:=0 to tprocdef(def).paras.count-1 do
  101. begin
  102. result:=jvmtypeneedssignature(tparavarsym(tprocdef(def).paras[i]).vardef);
  103. if result then
  104. exit;
  105. end;
  106. end
  107. else
  108. result:=false;
  109. end;
  110. end;
  111. procedure jvmaddencodedsignature(def: tdef; bpacked: boolean; var encodedstr: TSymStr);
  112. var
  113. founderror: tdef;
  114. begin
  115. case def.typ of
  116. pointerdef :
  117. begin
  118. { maybe one day }
  119. internalerror(2011051403);
  120. end;
  121. classrefdef :
  122. begin
  123. { Ljava/lang/Class<+SomeClassType> means
  124. "Ljava/lang/Class<SomeClassType_or_any_of_its_descendents>" }
  125. encodedstr:=encodedstr+'Ljava/lang/Class<+';
  126. jvmaddencodedtype(tclassrefdef(def).pointeddef,false,encodedstr,true,founderror);
  127. encodedstr:=encodedstr+'>;';
  128. end;
  129. setdef :
  130. begin
  131. if tsetdef(def).elementdef.typ=enumdef then
  132. begin
  133. encodedstr:=encodedstr+'Ljava/util/EnumSet<';
  134. jvmaddencodedtype(tenumdef(tsetdef(def).elementdef).getbasedef,false,encodedstr,true,founderror);
  135. encodedstr:=encodedstr+'>;';
  136. end
  137. else
  138. internalerror(2011051404);
  139. end;
  140. arraydef :
  141. begin
  142. if is_array_of_const(def) then
  143. begin
  144. internalerror(2011051405);
  145. end
  146. else if is_packed_array(def) then
  147. begin
  148. internalerror(2011051406);
  149. end
  150. else
  151. begin
  152. encodedstr:=encodedstr+'[';
  153. jvmaddencodedsignature(tarraydef(def).elementdef,false,encodedstr);
  154. end;
  155. end;
  156. procvardef :
  157. begin
  158. { maybe one day }
  159. internalerror(2011051407);
  160. end;
  161. objectdef :
  162. begin
  163. { maybe one day }
  164. end;
  165. undefineddef,
  166. errordef :
  167. begin
  168. internalerror(2011051408);
  169. end;
  170. procdef :
  171. { must be done via jvmencodemethod() }
  172. internalerror(2011051401);
  173. else
  174. internalerror(2011051402);
  175. end;
  176. end;
  177. function jvmaddencodedtype(def: tdef; bpacked: boolean; var encodedstr: TSymStr; forcesignature: boolean; out founderror: tdef): boolean;
  178. var
  179. c: char;
  180. begin
  181. result:=true;
  182. case def.typ of
  183. stringdef :
  184. begin
  185. case tstringdef(def).stringtype of
  186. { translated into java.lang.String }
  187. st_widestring,
  188. st_unicodestring:
  189. result:=jvmaddencodedtype(java_jlstring,false,encodedstr,forcesignature,founderror);
  190. st_ansistring:
  191. result:=jvmaddencodedtype(java_ansistring,false,encodedstr,forcesignature,founderror);
  192. st_shortstring:
  193. result:=jvmaddencodedtype(java_shortstring,false,encodedstr,forcesignature,founderror);
  194. else
  195. { May be handled via wrapping later }
  196. result:=false;
  197. end;
  198. end;
  199. enumdef:
  200. begin
  201. result:=jvmaddencodedtype(tcpuenumdef(tenumdef(def).getbasedef).classdef,false,encodedstr,forcesignature,founderror);
  202. end;
  203. orddef :
  204. begin
  205. { for procedure "results" }
  206. if is_void(def) then
  207. c:='V'
  208. { only Pascal-style booleans conform to Java's definition of
  209. Boolean }
  210. else if is_pasbool(def) and
  211. (def.size=1) then
  212. c:='Z'
  213. else if is_widechar(def) then
  214. c:='C'
  215. else
  216. begin
  217. case def.size of
  218. 1:
  219. c:='B';
  220. 2:
  221. c:='S';
  222. 4:
  223. c:='I';
  224. 8:
  225. c:='J';
  226. else
  227. internalerror(2010121905);
  228. end;
  229. end;
  230. encodedstr:=encodedstr+c;
  231. end;
  232. pointerdef :
  233. begin
  234. if is_voidpointer(def) then
  235. result:=jvmaddencodedtype(java_jlobject,false,encodedstr,forcesignature,founderror)
  236. else if jvmimplicitpointertype(tpointerdef(def).pointeddef) then
  237. result:=jvmaddencodedtype(tpointerdef(def).pointeddef,false,encodedstr,forcesignature,founderror)
  238. else
  239. begin
  240. { all pointer types are emulated via arrays }
  241. encodedstr:=encodedstr+'[';
  242. result:=jvmaddencodedtype(tpointerdef(def).pointeddef,false,encodedstr,forcesignature,founderror);
  243. end
  244. end;
  245. floatdef :
  246. begin
  247. case tfloatdef(def).floattype of
  248. s32real:
  249. c:='F';
  250. s64real:
  251. c:='D';
  252. else
  253. begin
  254. result:=false;
  255. c:=' ';
  256. end;
  257. end;
  258. encodedstr:=encodedstr+c;
  259. end;
  260. filedef :
  261. result:=false;
  262. recorddef :
  263. begin
  264. encodedstr:=encodedstr+'L'+trecorddef(def).jvm_full_typename(true)+';'
  265. end;
  266. variantdef :
  267. begin
  268. { will be hanlded via wrapping later, although wrapping may
  269. happen at higher level }
  270. result:=false;
  271. end;
  272. classrefdef :
  273. begin
  274. if not forcesignature then
  275. { unfortunately, java.lang.Class is final, so we can't create
  276. different versions for difference class reference types }
  277. encodedstr:=encodedstr+'Ljava/lang/Class;'
  278. { we can however annotate it with extra signature information in
  279. using Java's generic annotations }
  280. else
  281. jvmaddencodedsignature(def,false,encodedstr);
  282. result:=true;
  283. end;
  284. setdef :
  285. begin
  286. if tsetdef(def).elementdef.typ=enumdef then
  287. begin
  288. if forcesignature then
  289. jvmaddencodedsignature(def,false,encodedstr)
  290. else
  291. result:=jvmaddencodedtype(java_juenumset,false,encodedstr,forcesignature,founderror)
  292. end
  293. else
  294. result:=jvmaddencodedtype(java_jubitset,false,encodedstr,forcesignature,founderror)
  295. end;
  296. formaldef :
  297. begin
  298. { var/const/out x: JLObject }
  299. result:=jvmaddencodedtype(java_jlobject,false,encodedstr,forcesignature,founderror);
  300. end;
  301. arraydef :
  302. begin
  303. if is_array_of_const(def) then
  304. begin
  305. encodedstr:=encodedstr+'[';
  306. result:=jvmaddencodedtype(search_system_type('TVARREC').typedef,false,encodedstr,forcesignature,founderror);
  307. end
  308. else if is_packed_array(def) then
  309. result:=false
  310. else
  311. begin
  312. encodedstr:=encodedstr+'[';
  313. if not jvmaddencodedtype(tarraydef(def).elementdef,false,encodedstr,forcesignature,founderror) then
  314. begin
  315. result:=false;
  316. { report the exact (nested) error defintion }
  317. exit;
  318. end;
  319. end;
  320. end;
  321. procvardef :
  322. begin
  323. result:=jvmaddencodedtype(tcpuprocvardef(def).classdef,false,encodedstr,forcesignature,founderror);
  324. end;
  325. objectdef :
  326. case tobjectdef(def).objecttype of
  327. odt_javaclass,
  328. odt_interfacejava:
  329. begin
  330. def:=maybe_find_real_class_definition(def,false);
  331. encodedstr:=encodedstr+'L'+tobjectdef(def).jvm_full_typename(true)+';'
  332. end
  333. else
  334. result:=false;
  335. end;
  336. undefineddef,
  337. errordef :
  338. result:=false;
  339. procdef :
  340. { must be done via jvmencodemethod() }
  341. internalerror(2010121903);
  342. else
  343. internalerror(2010121904);
  344. end;
  345. if not result then
  346. founderror:=def;
  347. end;
  348. function jvmtryencodetype(def: tdef; out encodedtype: TSymStr; forcesignature: boolean; out founderror: tdef): boolean;
  349. begin
  350. encodedtype:='';
  351. result:=jvmaddencodedtype(def,false,encodedtype,forcesignature,founderror);
  352. end;
  353. procedure jvmaddtypeownerprefix(owner: tsymtable; var name: TSymStr);
  354. var
  355. owningcontainer: tsymtable;
  356. tmpresult: TSymStr;
  357. module: tmodule;
  358. nameendpos: longint;
  359. begin
  360. { see tprocdef.jvmmangledbasename for description of the format }
  361. owningcontainer:=owner;
  362. while (owningcontainer.symtabletype=localsymtable) do
  363. owningcontainer:=owningcontainer.defowner.owner;
  364. case owningcontainer.symtabletype of
  365. globalsymtable,
  366. staticsymtable:
  367. begin
  368. module:=find_module_from_symtable(owningcontainer);
  369. tmpresult:='';
  370. if assigned(module.namespace) then
  371. tmpresult:=module.namespace^+'/';
  372. tmpresult:=tmpresult+module.realmodulename^+'/';
  373. end;
  374. objectsymtable:
  375. case tobjectdef(owningcontainer.defowner).objecttype of
  376. odt_javaclass,
  377. odt_interfacejava:
  378. begin
  379. tmpresult:=tobjectdef(owningcontainer.defowner).jvm_full_typename(true)+'/'
  380. end
  381. else
  382. internalerror(2010122606);
  383. end;
  384. recordsymtable:
  385. tmpresult:=trecorddef(owningcontainer.defowner).jvm_full_typename(true)+'/'
  386. else
  387. internalerror(2010122605);
  388. end;
  389. name:=tmpresult+name;
  390. nameendpos:=pos(' ',name);
  391. if nameendpos=0 then
  392. nameendpos:=length(name)+1;
  393. insert('''',name,nameendpos);
  394. name:=''''+name;
  395. end;
  396. function jvmarrtype(def: tdef; out primitivetype: boolean): TSymStr;
  397. var
  398. errdef: tdef;
  399. begin
  400. if not jvmtryencodetype(def,result,false,errdef) then
  401. internalerror(2011012205);
  402. primitivetype:=false;
  403. if length(result)=1 then
  404. begin
  405. case result[1] of
  406. 'Z': result:='boolean';
  407. 'C': result:='char';
  408. 'B': result:='byte';
  409. 'S': result:='short';
  410. 'I': result:='int';
  411. 'J': result:='long';
  412. 'F': result:='float';
  413. 'D': result:='double';
  414. else
  415. internalerror(2011012206);
  416. end;
  417. primitivetype:=true;
  418. end
  419. else if (result[1]='L') then
  420. begin
  421. { in case of a class reference, strip the leading 'L' and the
  422. trailing ';' }
  423. setlength(result,length(result)-1);
  424. delete(result,1,1);
  425. end;
  426. { for arrays, use the actual reference type }
  427. end;
  428. function jvmarrtype_setlength(def: tdef): char;
  429. var
  430. errdef: tdef;
  431. res: TSymStr;
  432. begin
  433. { keep in sync with rtl/java/jdynarrh.inc and usage in njvminl }
  434. if is_record(def) then
  435. result:='R'
  436. else if is_shortstring(def) then
  437. result:='T'
  438. else if def.typ=setdef then
  439. begin
  440. if tsetdef(def).elementdef.typ=enumdef then
  441. result:='E'
  442. else
  443. result:='L'
  444. end
  445. else if (def.typ=procvardef) and
  446. not tprocvardef(def).is_addressonly then
  447. result:='P'
  448. else
  449. begin
  450. if not jvmtryencodetype(def,res,false,errdef) then
  451. internalerror(2011012209);
  452. if length(res)=1 then
  453. result:=res[1]
  454. else
  455. result:='A';
  456. end;
  457. end;
  458. function jvmimplicitpointertype(def: tdef): boolean;
  459. begin
  460. case def.typ of
  461. arraydef:
  462. result:=(tarraydef(def).highrange>=tarraydef(def).lowrange) or
  463. is_open_array(def) or
  464. is_array_of_const(def) or
  465. is_array_constructor(def);
  466. recorddef,
  467. setdef:
  468. result:=true;
  469. objectdef:
  470. result:=is_object(def);
  471. stringdef :
  472. result:=tstringdef(def).stringtype in [st_shortstring,st_longstring];
  473. procvardef:
  474. result:=not tprocvardef(def).is_addressonly;
  475. else
  476. result:=false;
  477. end;
  478. end;
  479. { mergeints = true means that all integer types are mapped to jllong,
  480. otherwise they are mapped to the closest corresponding type }
  481. procedure jvmgetboxtype(def: tdef; out objdef, paradef: tdef; mergeints: boolean);
  482. begin
  483. case def.typ of
  484. orddef:
  485. begin
  486. case torddef(def).ordtype of
  487. pasbool8:
  488. begin
  489. objdef:=tobjectdef(search_system_type('JLBOOLEAN').typedef);
  490. paradef:=pasbool8type;
  491. end;
  492. uwidechar:
  493. begin
  494. objdef:=tobjectdef(search_system_type('JLCHARACTER').typedef);
  495. paradef:=cwidechartype;
  496. end;
  497. else
  498. begin
  499. { wrap all integer types into a JLLONG, so that we don't get
  500. errors after returning a byte assigned to a long etc }
  501. if mergeints or
  502. (torddef(def).ordtype in [s64bit,u64bit,scurrency,bool64bit,pasbool64]) then
  503. begin
  504. objdef:=tobjectdef(search_system_type('JLLONG').typedef);
  505. paradef:=s64inttype;
  506. end
  507. else
  508. begin
  509. case torddef(def).ordtype of
  510. s8bit,
  511. u8bit,
  512. uchar,
  513. bool8bit:
  514. begin
  515. objdef:=tobjectdef(search_system_type('JLBYTE').typedef);
  516. paradef:=s8inttype;
  517. end;
  518. s16bit,
  519. u16bit,
  520. bool16bit,
  521. pasbool16:
  522. begin
  523. objdef:=tobjectdef(search_system_type('JLSHORT').typedef);
  524. paradef:=s16inttype;
  525. end;
  526. s32bit,
  527. u32bit,
  528. bool32bit,
  529. pasbool32:
  530. begin
  531. objdef:=tobjectdef(search_system_type('JLINTEGER').typedef);
  532. paradef:=s32inttype;
  533. end;
  534. else
  535. internalerror(2011052101);
  536. end;
  537. end;
  538. end;
  539. end;
  540. end;
  541. floatdef:
  542. begin
  543. case tfloatdef(def).floattype of
  544. s32real:
  545. begin
  546. objdef:=tobjectdef(search_system_type('JLFLOAT').typedef);
  547. paradef:=s32floattype;
  548. end;
  549. s64real:
  550. begin
  551. objdef:=tobjectdef(search_system_type('JLDOUBLE').typedef);
  552. paradef:=s64floattype;
  553. end;
  554. else
  555. internalerror(2011052102);
  556. end;
  557. end;
  558. else
  559. internalerror(2011052103);
  560. end;
  561. end;
  562. function jvmgetunboxmethod(def: tdef): string;
  563. begin
  564. case def.typ of
  565. orddef:
  566. begin
  567. case torddef(def).ordtype of
  568. pasbool8:
  569. result:='BOOLEANVALUE';
  570. s8bit,
  571. u8bit,
  572. uchar,
  573. bool8bit:
  574. result:='BYTEVALUE';
  575. s16bit,
  576. u16bit,
  577. bool16bit,
  578. pasbool16:
  579. result:='SHORTVALUE';
  580. s32bit,
  581. u32bit,
  582. bool32bit,
  583. pasbool32:
  584. result:='INTVALUE';
  585. s64bit,
  586. u64bit,
  587. scurrency,
  588. bool64bit,
  589. pasbool64:
  590. result:='LONGVALUE';
  591. uwidechar:
  592. result:='CHARVALUE';
  593. else
  594. internalerror(2011071702);
  595. end;
  596. end;
  597. floatdef:
  598. begin
  599. case tfloatdef(def).floattype of
  600. s32real:
  601. result:='FLOATVALUE';
  602. s64real:
  603. result:='DOUBLEVALUE';
  604. else
  605. internalerror(2011071703);
  606. end;
  607. end;
  608. else
  609. internalerror(2011071704);
  610. end;
  611. end;
  612. function jvmgetcorrespondingclassdef(def: tdef): tdef;
  613. var
  614. paradef: tdef;
  615. begin
  616. if def.typ in [orddef,floatdef] then
  617. jvmgetboxtype(def,result,paradef,false)
  618. else
  619. begin
  620. case def.typ of
  621. stringdef :
  622. begin
  623. case tstringdef(def).stringtype of
  624. { translated into java.lang.String }
  625. st_widestring,
  626. st_unicodestring:
  627. result:=java_jlstring;
  628. st_ansistring:
  629. result:=java_ansistring;
  630. st_shortstring:
  631. result:=java_shortstring;
  632. else
  633. internalerror(2011072409);
  634. end;
  635. end;
  636. enumdef:
  637. begin
  638. result:=tcpuenumdef(tenumdef(def).getbasedef).classdef;
  639. end;
  640. pointerdef :
  641. begin
  642. if def=voidpointertype then
  643. result:=java_jlobject
  644. else if jvmimplicitpointertype(tpointerdef(def).pointeddef) then
  645. result:=tpointerdef(def).pointeddef
  646. else
  647. internalerror(2011072410);
  648. end;
  649. recorddef :
  650. begin
  651. result:=def;
  652. end;
  653. variantdef :
  654. begin
  655. result:=cvarianttype;
  656. end;
  657. classrefdef :
  658. begin
  659. result:=search_system_type('JLCLASS').typedef;
  660. end;
  661. setdef :
  662. begin
  663. if tsetdef(def).elementdef.typ=enumdef then
  664. result:=java_juenumset
  665. else
  666. result:=java_jubitset;
  667. end;
  668. formaldef :
  669. begin
  670. result:=java_jlobject;
  671. end;
  672. arraydef :
  673. begin
  674. { cannot represent statically }
  675. internalerror(2011072411);
  676. end;
  677. procvardef :
  678. begin
  679. result:=tcpuprocvardef(def).classdef;
  680. end;
  681. objectdef :
  682. case tobjectdef(def).objecttype of
  683. odt_javaclass,
  684. odt_interfacejava:
  685. result:=def
  686. else
  687. internalerror(2011072412);
  688. end;
  689. else
  690. internalerror(2011072413);
  691. end;
  692. end;
  693. end;
  694. function get_para_push_size(def: tdef): tdef;
  695. begin
  696. result:=def;
  697. if def.typ=orddef then
  698. case torddef(def).ordtype of
  699. u8bit,uchar:
  700. if torddef(def).high>127 then
  701. result:=s8inttype;
  702. u16bit:
  703. if torddef(def).high>32767 then
  704. result:=s16inttype;
  705. end;
  706. end;
  707. function jvmgetthreadvardef(def: tdef): tdef;
  708. begin
  709. if (def.typ=arraydef) and
  710. not is_dynamic_array(def) then
  711. begin
  712. result:=search_system_type('FPCNORMALARRAYTHREADVAR').typedef;
  713. exit;
  714. end;
  715. if jvmimplicitpointertype(def) then
  716. begin
  717. result:=search_system_type('FPCIMPLICITPTRTHREADVAR').typedef;
  718. exit;
  719. end;
  720. case def.typ of
  721. orddef:
  722. begin
  723. case torddef(def).ordtype of
  724. pasbool8:
  725. begin
  726. result:=tobjectdef(search_system_type('FPCBOOLEANTHREADVAR').typedef);
  727. end;
  728. uwidechar:
  729. begin
  730. result:=tobjectdef(search_system_type('FPCCHARTHREADVAR').typedef);
  731. end;
  732. s8bit,
  733. u8bit,
  734. uchar,
  735. bool8bit:
  736. begin
  737. result:=tobjectdef(search_system_type('FPCBYTETHREADVAR').typedef);
  738. end;
  739. s16bit,
  740. u16bit,
  741. bool16bit,
  742. pasbool16:
  743. begin
  744. result:=tobjectdef(search_system_type('FPCSHORTTHREADVAR').typedef);
  745. end;
  746. s32bit,
  747. u32bit,
  748. bool32bit,
  749. pasbool32:
  750. begin
  751. result:=tobjectdef(search_system_type('FPCINTTHREADVAR').typedef);
  752. end;
  753. s64bit,
  754. u64bit,
  755. scurrency,
  756. bool64bit,
  757. pasbool64:
  758. begin
  759. result:=tobjectdef(search_system_type('FPCLONGTHREADVAR').typedef);
  760. end
  761. else
  762. internalerror(2011082101);
  763. end;
  764. end;
  765. floatdef:
  766. begin
  767. case tfloatdef(def).floattype of
  768. s32real:
  769. begin
  770. result:=tobjectdef(search_system_type('FPCFLOATTHREADVAR').typedef);
  771. end;
  772. s64real:
  773. begin
  774. result:=tobjectdef(search_system_type('FPCDOUBLETHREADVAR').typedef);
  775. end;
  776. else
  777. internalerror(2011082102);
  778. end;
  779. end
  780. else
  781. begin
  782. result:=search_system_type('FPCPOINTERTHREADVAR').typedef
  783. end;
  784. end;
  785. end;
  786. procedure jvmgetarraydimdef(arrdef: tdef; out eledef: tdef; out ndim: longint);
  787. begin
  788. eledef:=arrdef;
  789. ndim:=0;
  790. repeat
  791. eledef:=tarraydef(eledef).elementdef;
  792. inc(ndim);
  793. until (eledef.typ<>arraydef) or
  794. is_dynamic_array(eledef);
  795. end;
  796. function jvmmangledbasename(sym: tsym; const usesymname: TSymStr; withsignature: boolean): TSymStr;
  797. var
  798. container: tsymtable;
  799. vsym: tabstractvarsym;
  800. csym: tconstsym;
  801. usedef: tdef;
  802. begin
  803. case sym.typ of
  804. staticvarsym,
  805. paravarsym,
  806. localvarsym,
  807. fieldvarsym:
  808. begin
  809. vsym:=tabstractvarsym(sym);
  810. { for local and paravarsyms that are unsigned 8/16 bit, change the
  811. outputted type to signed 16/32 bit:
  812. a) the stack slots are all 32 bit anyway, so the storage allocation
  813. is still correct
  814. b) since at the JVM level all types are signed, this makes sure
  815. that the values in the stack slots are valid for the specified
  816. types
  817. }
  818. usedef:=vsym.vardef;
  819. if vsym.typ in [localvarsym,paravarsym] then
  820. begin
  821. if (usedef.typ=orddef) then
  822. case torddef(usedef).ordtype of
  823. u8bit,uchar:
  824. usedef:=s16inttype;
  825. u16bit:
  826. usedef:=s32inttype;
  827. end;
  828. end;
  829. result:=jvmencodetype(usedef,false);
  830. if withsignature and
  831. jvmtypeneedssignature(usedef) then
  832. begin
  833. result:=result+' signature "';
  834. result:=result+jvmencodetype(usedef,true)+'"';
  835. end;
  836. if (vsym.typ=paravarsym) and
  837. (vo_is_self in tparavarsym(vsym).varoptions) then
  838. result:='''this'' ' +result
  839. else if (vsym.typ in [paravarsym,localvarsym]) and
  840. ([vo_is_funcret,vo_is_result] * tabstractnormalvarsym(vsym).varoptions <> []) then
  841. result:='''result'' '+result
  842. else
  843. begin
  844. { add array indirection if required }
  845. if (vsym.typ=paravarsym) and
  846. ((usedef.typ=formaldef) or
  847. ((vsym.varspez in [vs_var,vs_out,vs_constref]) and
  848. not jvmimplicitpointertype(usedef))) then
  849. result:='['+result;
  850. { single quotes for definitions to prevent clashes with Java
  851. opcodes }
  852. if withsignature then
  853. result:=usesymname+''' '+result
  854. else
  855. result:=usesymname+' '+result;
  856. { we have to mangle staticvarsyms in localsymtables to
  857. prevent name clashes... }
  858. if (vsym.typ=staticvarsym) then
  859. begin
  860. container:=sym.Owner;
  861. while (container.symtabletype=localsymtable) do
  862. begin
  863. if tdef(container.defowner).typ<>procdef then
  864. internalerror(2011040303);
  865. { defid is added to prevent problem with overloads }
  866. result:=tprocdef(container.defowner).procsym.realname+'$$'+tostr(tprocdef(container.defowner).defid)+'$'+result;
  867. container:=container.defowner.owner;
  868. end;
  869. end;
  870. if withsignature then
  871. result:=''''+result
  872. end;
  873. end;
  874. constsym:
  875. begin
  876. csym:=tconstsym(sym);
  877. { some constants can be untyped }
  878. if assigned(csym.constdef) and
  879. not(csym.consttyp in [constwstring,conststring]) then
  880. begin
  881. result:=jvmencodetype(csym.constdef,false);
  882. if withsignature and
  883. jvmtypeneedssignature(csym.constdef) then
  884. begin
  885. result:=result+' signature "';
  886. result:=result+jvmencodetype(csym.constdef,true)+'"';
  887. end;
  888. end
  889. else
  890. begin
  891. case csym.consttyp of
  892. constord:
  893. result:=jvmencodetype(s32inttype,withsignature);
  894. constreal:
  895. result:=jvmencodetype(s64floattype,withsignature);
  896. constset:
  897. internalerror(2011040701);
  898. constpointer,
  899. constnil:
  900. result:=jvmencodetype(java_jlobject,withsignature);
  901. constwstring,
  902. conststring:
  903. result:=jvmencodetype(java_jlstring,withsignature);
  904. constresourcestring:
  905. internalerror(2011040702);
  906. else
  907. internalerror(2011040703);
  908. end;
  909. end;
  910. if withsignature then
  911. result:=''''+usesymname+''' '+result
  912. else
  913. result:=usesymname+' '+result
  914. end;
  915. else
  916. internalerror(2011021703);
  917. end;
  918. end;
  919. function jvmmangledbasename(sym: tsym; withsignature: boolean): TSymStr;
  920. begin
  921. if (sym.typ=fieldvarsym) and
  922. assigned(tfieldvarsym(sym).externalname) then
  923. result:=jvmmangledbasename(sym,tfieldvarsym(sym).externalname^,withsignature)
  924. else if (sym.typ=staticvarsym) and
  925. (tstaticvarsym(sym).mangledbasename<>'') then
  926. result:=jvmmangledbasename(sym,tstaticvarsym(sym).mangledbasename,withsignature)
  927. else
  928. result:=jvmmangledbasename(sym,sym.RealName,withsignature);
  929. end;
  930. {******************************************************************
  931. jvm type validity checking
  932. *******************************************************************}
  933. function jvmencodetype(def: tdef; withsignature: boolean): TSymStr;
  934. var
  935. errordef: tdef;
  936. begin
  937. if not jvmtryencodetype(def,result,withsignature,errordef) then
  938. internalerror(2011012305);
  939. end;
  940. function jvmchecktype(def: tdef; out founderror: tdef): boolean;
  941. var
  942. encodedtype: TSymStr;
  943. begin
  944. { don't duplicate the code like in objcdef, since the resulting strings
  945. are much shorter here so it's not worth it }
  946. result:=jvmtryencodetype(def,encodedtype,false,founderror);
  947. end;
  948. end.