jvmdef.pas 41 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168
  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,symdef;
  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. { the JVM specs require that you add a default parameterless
  70. constructor in case the programmer hasn't specified any }
  71. procedure maybe_add_public_default_java_constructor(obj: tabstractrecorddef);
  72. implementation
  73. uses
  74. cutils,cclasses,constexp,
  75. verbose,systems,
  76. fmodule,
  77. symtable,symconst,symsym,symcpu,symcreat,
  78. pparautl,
  79. defutil,paramgr;
  80. {******************************************************************
  81. Type encoding
  82. *******************************************************************}
  83. function jvmtypeneedssignature(def: tdef): boolean;
  84. var
  85. i: longint;
  86. begin
  87. result:=false;
  88. case def.typ of
  89. classrefdef,
  90. setdef:
  91. begin
  92. result:=true;
  93. end;
  94. arraydef :
  95. begin
  96. result:=jvmtypeneedssignature(tarraydef(def).elementdef);
  97. end;
  98. procvardef :
  99. begin
  100. { may change in the future }
  101. end;
  102. procdef :
  103. begin
  104. for i:=0 to tprocdef(def).paras.count-1 do
  105. begin
  106. result:=jvmtypeneedssignature(tparavarsym(tprocdef(def).paras[i]).vardef);
  107. if result then
  108. exit;
  109. end;
  110. end
  111. else
  112. result:=false;
  113. end;
  114. end;
  115. procedure jvmaddencodedsignature(def: tdef; bpacked: boolean; var encodedstr: TSymStr);
  116. var
  117. founderror: tdef;
  118. begin
  119. case def.typ of
  120. pointerdef :
  121. begin
  122. { maybe one day }
  123. internalerror(2011051403);
  124. end;
  125. classrefdef :
  126. begin
  127. { Ljava/lang/Class<+SomeClassType> means
  128. "Ljava/lang/Class<SomeClassType_or_any_of_its_descendents>" }
  129. encodedstr:=encodedstr+'Ljava/lang/Class<+';
  130. jvmaddencodedtype(tclassrefdef(def).pointeddef,false,encodedstr,true,founderror);
  131. encodedstr:=encodedstr+'>;';
  132. end;
  133. setdef :
  134. begin
  135. if tsetdef(def).elementdef.typ=enumdef then
  136. begin
  137. encodedstr:=encodedstr+'Ljava/util/EnumSet<';
  138. jvmaddencodedtype(tenumdef(tsetdef(def).elementdef).getbasedef,false,encodedstr,true,founderror);
  139. encodedstr:=encodedstr+'>;';
  140. end
  141. else
  142. internalerror(2011051404);
  143. end;
  144. arraydef :
  145. begin
  146. if is_array_of_const(def) then
  147. begin
  148. internalerror(2011051405);
  149. end
  150. else if is_packed_array(def) then
  151. begin
  152. internalerror(2011051406);
  153. end
  154. else
  155. begin
  156. encodedstr:=encodedstr+'[';
  157. jvmaddencodedsignature(tarraydef(def).elementdef,false,encodedstr);
  158. end;
  159. end;
  160. procvardef :
  161. begin
  162. { maybe one day }
  163. internalerror(2011051407);
  164. end;
  165. objectdef :
  166. begin
  167. { maybe one day }
  168. end;
  169. undefineddef,
  170. errordef :
  171. begin
  172. internalerror(2011051408);
  173. end;
  174. procdef :
  175. { must be done via jvmencodemethod() }
  176. internalerror(2011051401);
  177. else
  178. internalerror(2011051402);
  179. end;
  180. end;
  181. function jvmaddencodedtype(def: tdef; bpacked: boolean; var encodedstr: TSymStr; forcesignature: boolean; out founderror: tdef): boolean;
  182. var
  183. c: char;
  184. begin
  185. result:=true;
  186. case def.typ of
  187. stringdef :
  188. begin
  189. case tstringdef(def).stringtype of
  190. { translated into java.lang.String }
  191. st_widestring,
  192. st_unicodestring:
  193. result:=jvmaddencodedtype(java_jlstring,false,encodedstr,forcesignature,founderror);
  194. st_ansistring:
  195. result:=jvmaddencodedtype(java_ansistring,false,encodedstr,forcesignature,founderror);
  196. st_shortstring:
  197. result:=jvmaddencodedtype(java_shortstring,false,encodedstr,forcesignature,founderror);
  198. else
  199. { May be handled via wrapping later }
  200. result:=false;
  201. end;
  202. end;
  203. enumdef:
  204. begin
  205. result:=jvmaddencodedtype(tcpuenumdef(tenumdef(def).getbasedef).classdef,false,encodedstr,forcesignature,founderror);
  206. end;
  207. orddef :
  208. begin
  209. { for procedure "results" }
  210. if is_void(def) then
  211. c:='V'
  212. { only Pascal-style booleans conform to Java's definition of
  213. Boolean }
  214. else if is_pasbool(def) and
  215. (def.size=1) then
  216. c:='Z'
  217. else if is_widechar(def) then
  218. c:='C'
  219. else
  220. begin
  221. case def.size of
  222. 1:
  223. c:='B';
  224. 2:
  225. c:='S';
  226. 4:
  227. c:='I';
  228. 8:
  229. c:='J';
  230. else
  231. internalerror(2010121905);
  232. end;
  233. end;
  234. encodedstr:=encodedstr+c;
  235. end;
  236. pointerdef :
  237. begin
  238. if is_voidpointer(def) then
  239. result:=jvmaddencodedtype(java_jlobject,false,encodedstr,forcesignature,founderror)
  240. else if jvmimplicitpointertype(tpointerdef(def).pointeddef) then
  241. result:=jvmaddencodedtype(tpointerdef(def).pointeddef,false,encodedstr,forcesignature,founderror)
  242. else
  243. begin
  244. { all pointer types are emulated via arrays }
  245. encodedstr:=encodedstr+'[';
  246. result:=jvmaddencodedtype(tpointerdef(def).pointeddef,false,encodedstr,forcesignature,founderror);
  247. end
  248. end;
  249. floatdef :
  250. begin
  251. case tfloatdef(def).floattype of
  252. s32real:
  253. c:='F';
  254. s64real:
  255. c:='D';
  256. else
  257. begin
  258. result:=false;
  259. c:=' ';
  260. end;
  261. end;
  262. encodedstr:=encodedstr+c;
  263. end;
  264. filedef :
  265. begin
  266. case tfiledef(def).filetyp of
  267. ft_text:
  268. result:=jvmaddencodedtype(search_system_type('TEXTREC').typedef,false,encodedstr,forcesignature,founderror);
  269. ft_typed,
  270. ft_untyped:
  271. result:=jvmaddencodedtype(search_system_type('FILEREC').typedef,false,encodedstr,forcesignature,founderror);
  272. end;
  273. end;
  274. recorddef :
  275. begin
  276. encodedstr:=encodedstr+'L'+trecorddef(def).jvm_full_typename(true)+';'
  277. end;
  278. variantdef :
  279. begin
  280. { will be hanlded via wrapping later, although wrapping may
  281. happen at higher level }
  282. result:=false;
  283. end;
  284. classrefdef :
  285. begin
  286. if not forcesignature then
  287. { unfortunately, java.lang.Class is final, so we can't create
  288. different versions for difference class reference types }
  289. encodedstr:=encodedstr+'Ljava/lang/Class;'
  290. { we can however annotate it with extra signature information in
  291. using Java's generic annotations }
  292. else
  293. jvmaddencodedsignature(def,false,encodedstr);
  294. result:=true;
  295. end;
  296. setdef :
  297. begin
  298. if tsetdef(def).elementdef.typ=enumdef then
  299. begin
  300. if forcesignature then
  301. jvmaddencodedsignature(def,false,encodedstr)
  302. else
  303. result:=jvmaddencodedtype(java_juenumset,false,encodedstr,forcesignature,founderror)
  304. end
  305. else
  306. result:=jvmaddencodedtype(java_jubitset,false,encodedstr,forcesignature,founderror)
  307. end;
  308. formaldef :
  309. begin
  310. { var/const/out x: JLObject }
  311. result:=jvmaddencodedtype(java_jlobject,false,encodedstr,forcesignature,founderror);
  312. end;
  313. arraydef :
  314. begin
  315. if is_array_of_const(def) then
  316. begin
  317. encodedstr:=encodedstr+'[';
  318. result:=jvmaddencodedtype(search_system_type('TVARREC').typedef,false,encodedstr,forcesignature,founderror);
  319. end
  320. else if is_packed_array(def) then
  321. result:=false
  322. else
  323. begin
  324. encodedstr:=encodedstr+'[';
  325. if not jvmaddencodedtype(tarraydef(def).elementdef,false,encodedstr,forcesignature,founderror) then
  326. begin
  327. result:=false;
  328. { report the exact (nested) error defintion }
  329. exit;
  330. end;
  331. end;
  332. end;
  333. procvardef :
  334. begin
  335. result:=jvmaddencodedtype(tcpuprocvardef(def).classdef,false,encodedstr,forcesignature,founderror);
  336. end;
  337. objectdef :
  338. case tobjectdef(def).objecttype of
  339. odt_javaclass,
  340. odt_interfacejava:
  341. begin
  342. def:=maybe_find_real_class_definition(def,false);
  343. encodedstr:=encodedstr+'L'+tobjectdef(def).jvm_full_typename(true)+';'
  344. end
  345. else
  346. result:=false;
  347. end;
  348. undefineddef,
  349. errordef :
  350. result:=false;
  351. procdef :
  352. { must be done via jvmencodemethod() }
  353. internalerror(2010121903);
  354. else
  355. internalerror(2010121904);
  356. end;
  357. if not result then
  358. founderror:=def;
  359. end;
  360. function jvmtryencodetype(def: tdef; out encodedtype: TSymStr; forcesignature: boolean; out founderror: tdef): boolean;
  361. begin
  362. encodedtype:='';
  363. result:=jvmaddencodedtype(def,false,encodedtype,forcesignature,founderror);
  364. end;
  365. procedure jvmaddtypeownerprefix(owner: tsymtable; var name: TSymStr);
  366. var
  367. owningcontainer: tsymtable;
  368. tmpresult: TSymStr;
  369. module: tmodule;
  370. nameendpos: longint;
  371. begin
  372. { see tprocdef.jvmmangledbasename for description of the format }
  373. owningcontainer:=owner;
  374. while (owningcontainer.symtabletype=localsymtable) do
  375. owningcontainer:=owningcontainer.defowner.owner;
  376. case owningcontainer.symtabletype of
  377. globalsymtable,
  378. staticsymtable:
  379. begin
  380. module:=find_module_from_symtable(owningcontainer);
  381. tmpresult:='';
  382. if assigned(module.namespace) then
  383. tmpresult:=module.namespace^+'/';
  384. tmpresult:=tmpresult+module.realmodulename^+'/';
  385. end;
  386. objectsymtable:
  387. case tobjectdef(owningcontainer.defowner).objecttype of
  388. odt_javaclass,
  389. odt_interfacejava:
  390. begin
  391. tmpresult:=tobjectdef(owningcontainer.defowner).jvm_full_typename(true)+'/'
  392. end
  393. else
  394. internalerror(2010122606);
  395. end;
  396. recordsymtable:
  397. tmpresult:=trecorddef(owningcontainer.defowner).jvm_full_typename(true)+'/'
  398. else
  399. internalerror(2010122605);
  400. end;
  401. name:=tmpresult+name;
  402. nameendpos:=pos(' ',name);
  403. if nameendpos=0 then
  404. nameendpos:=length(name)+1;
  405. insert('''',name,nameendpos);
  406. name:=''''+name;
  407. end;
  408. function jvmarrtype(def: tdef; out primitivetype: boolean): TSymStr;
  409. var
  410. errdef: tdef;
  411. begin
  412. if not jvmtryencodetype(def,result,false,errdef) then
  413. internalerror(2011012205);
  414. primitivetype:=false;
  415. if length(result)=1 then
  416. begin
  417. case result[1] of
  418. 'Z': result:='boolean';
  419. 'C': result:='char';
  420. 'B': result:='byte';
  421. 'S': result:='short';
  422. 'I': result:='int';
  423. 'J': result:='long';
  424. 'F': result:='float';
  425. 'D': result:='double';
  426. else
  427. internalerror(2011012206);
  428. end;
  429. primitivetype:=true;
  430. end
  431. else if (result[1]='L') then
  432. begin
  433. { in case of a class reference, strip the leading 'L' and the
  434. trailing ';' }
  435. setlength(result,length(result)-1);
  436. delete(result,1,1);
  437. end;
  438. { for arrays, use the actual reference type }
  439. end;
  440. function jvmarrtype_setlength(def: tdef): char;
  441. var
  442. errdef: tdef;
  443. res: TSymStr;
  444. begin
  445. { keep in sync with rtl/java/jdynarrh.inc and usage in njvminl }
  446. if is_record(def) then
  447. result:='R'
  448. else if is_shortstring(def) then
  449. result:='T'
  450. else if def.typ=setdef then
  451. begin
  452. if tsetdef(def).elementdef.typ=enumdef then
  453. result:='E'
  454. else
  455. result:='L'
  456. end
  457. else if (def.typ=procvardef) and
  458. not tprocvardef(def).is_addressonly then
  459. result:='P'
  460. else
  461. begin
  462. if not jvmtryencodetype(def,res,false,errdef) then
  463. internalerror(2011012209);
  464. if length(res)=1 then
  465. result:=res[1]
  466. else
  467. result:='A';
  468. end;
  469. end;
  470. function jvmimplicitpointertype(def: tdef): boolean;
  471. begin
  472. case def.typ of
  473. arraydef:
  474. result:=(tarraydef(def).highrange>=tarraydef(def).lowrange) or
  475. is_open_array(def) or
  476. is_array_of_const(def) or
  477. is_array_constructor(def);
  478. filedef,
  479. recorddef,
  480. setdef:
  481. result:=true;
  482. objectdef:
  483. result:=is_object(def);
  484. stringdef :
  485. result:=tstringdef(def).stringtype in [st_shortstring,st_longstring];
  486. procvardef:
  487. result:=not tprocvardef(def).is_addressonly;
  488. else
  489. result:=false;
  490. end;
  491. end;
  492. { mergeints = true means that all integer types are mapped to jllong,
  493. otherwise they are mapped to the closest corresponding type }
  494. procedure jvmgetboxtype(def: tdef; out objdef, paradef: tdef; mergeints: boolean);
  495. begin
  496. case def.typ of
  497. orddef:
  498. begin
  499. case torddef(def).ordtype of
  500. pasbool1,
  501. pasbool8:
  502. begin
  503. objdef:=tobjectdef(search_system_type('JLBOOLEAN').typedef);
  504. paradef:=pasbool8type;
  505. end;
  506. uwidechar:
  507. begin
  508. objdef:=tobjectdef(search_system_type('JLCHARACTER').typedef);
  509. paradef:=cwidechartype;
  510. end;
  511. else
  512. begin
  513. { wrap all integer types into a JLLONG, so that we don't get
  514. errors after returning a byte assigned to a long etc }
  515. if mergeints or
  516. (torddef(def).ordtype in [s64bit,u64bit,scurrency,bool64bit,pasbool64]) then
  517. begin
  518. objdef:=tobjectdef(search_system_type('JLLONG').typedef);
  519. paradef:=s64inttype;
  520. end
  521. else
  522. begin
  523. case torddef(def).ordtype of
  524. s8bit,
  525. u8bit,
  526. uchar,
  527. bool8bit:
  528. begin
  529. objdef:=tobjectdef(search_system_type('JLBYTE').typedef);
  530. paradef:=s8inttype;
  531. end;
  532. s16bit,
  533. u16bit,
  534. bool16bit,
  535. pasbool16:
  536. begin
  537. objdef:=tobjectdef(search_system_type('JLSHORT').typedef);
  538. paradef:=s16inttype;
  539. end;
  540. s32bit,
  541. u32bit,
  542. bool32bit,
  543. pasbool32:
  544. begin
  545. objdef:=tobjectdef(search_system_type('JLINTEGER').typedef);
  546. paradef:=s32inttype;
  547. end;
  548. else
  549. internalerror(2011052101);
  550. end;
  551. end;
  552. end;
  553. end;
  554. end;
  555. floatdef:
  556. begin
  557. case tfloatdef(def).floattype of
  558. s32real:
  559. begin
  560. objdef:=tobjectdef(search_system_type('JLFLOAT').typedef);
  561. paradef:=s32floattype;
  562. end;
  563. s64real:
  564. begin
  565. objdef:=tobjectdef(search_system_type('JLDOUBLE').typedef);
  566. paradef:=s64floattype;
  567. end;
  568. else
  569. internalerror(2011052102);
  570. end;
  571. end;
  572. else
  573. internalerror(2011052103);
  574. end;
  575. end;
  576. function jvmgetunboxmethod(def: tdef): string;
  577. begin
  578. case def.typ of
  579. orddef:
  580. begin
  581. case torddef(def).ordtype of
  582. pasbool1,
  583. pasbool8:
  584. result:='BOOLEANVALUE';
  585. s8bit,
  586. u8bit,
  587. uchar,
  588. bool8bit:
  589. result:='BYTEVALUE';
  590. s16bit,
  591. u16bit,
  592. bool16bit,
  593. pasbool16:
  594. result:='SHORTVALUE';
  595. s32bit,
  596. u32bit,
  597. bool32bit,
  598. pasbool32:
  599. result:='INTVALUE';
  600. s64bit,
  601. u64bit,
  602. scurrency,
  603. bool64bit,
  604. pasbool64:
  605. result:='LONGVALUE';
  606. uwidechar:
  607. result:='CHARVALUE';
  608. else
  609. internalerror(2011071702);
  610. end;
  611. end;
  612. floatdef:
  613. begin
  614. case tfloatdef(def).floattype of
  615. s32real:
  616. result:='FLOATVALUE';
  617. s64real:
  618. result:='DOUBLEVALUE';
  619. else
  620. internalerror(2011071703);
  621. end;
  622. end;
  623. else
  624. internalerror(2011071704);
  625. end;
  626. end;
  627. function jvmgetcorrespondingclassdef(def: tdef): tdef;
  628. var
  629. paradef: tdef;
  630. begin
  631. if def.typ in [orddef,floatdef] then
  632. jvmgetboxtype(def,result,paradef,false)
  633. else
  634. begin
  635. case def.typ of
  636. stringdef :
  637. begin
  638. case tstringdef(def).stringtype of
  639. { translated into java.lang.String }
  640. st_widestring,
  641. st_unicodestring:
  642. result:=java_jlstring;
  643. st_ansistring:
  644. result:=java_ansistring;
  645. st_shortstring:
  646. result:=java_shortstring;
  647. else
  648. internalerror(2011072409);
  649. end;
  650. end;
  651. enumdef:
  652. begin
  653. result:=tcpuenumdef(tenumdef(def).getbasedef).classdef;
  654. end;
  655. pointerdef :
  656. begin
  657. if def=voidpointertype then
  658. result:=java_jlobject
  659. else if jvmimplicitpointertype(tpointerdef(def).pointeddef) then
  660. result:=tpointerdef(def).pointeddef
  661. else
  662. internalerror(2011072410);
  663. end;
  664. recorddef :
  665. begin
  666. result:=def;
  667. end;
  668. variantdef :
  669. begin
  670. result:=cvarianttype;
  671. end;
  672. classrefdef :
  673. begin
  674. result:=search_system_type('JLCLASS').typedef;
  675. end;
  676. setdef :
  677. begin
  678. if tsetdef(def).elementdef.typ=enumdef then
  679. result:=java_juenumset
  680. else
  681. result:=java_jubitset;
  682. end;
  683. formaldef :
  684. begin
  685. result:=java_jlobject;
  686. end;
  687. arraydef :
  688. begin
  689. { cannot represent statically }
  690. internalerror(2011072411);
  691. end;
  692. procvardef :
  693. begin
  694. result:=tcpuprocvardef(def).classdef;
  695. end;
  696. objectdef :
  697. case tobjectdef(def).objecttype of
  698. odt_javaclass,
  699. odt_interfacejava:
  700. result:=def
  701. else
  702. internalerror(2011072412);
  703. end;
  704. else
  705. internalerror(2011072413);
  706. end;
  707. end;
  708. end;
  709. function get_para_push_size(def: tdef): tdef;
  710. begin
  711. result:=def;
  712. if def.typ=orddef then
  713. case torddef(def).ordtype of
  714. u8bit,uchar:
  715. if torddef(def).high>127 then
  716. result:=s8inttype;
  717. u16bit:
  718. begin
  719. if torddef(def).high>32767 then
  720. result:=s16inttype;
  721. end
  722. else
  723. ;
  724. end;
  725. end;
  726. function jvmgetthreadvardef(def: tdef): tdef;
  727. begin
  728. if (def.typ=arraydef) and
  729. not is_dynamic_array(def) then
  730. begin
  731. result:=search_system_type('FPCNORMALARRAYTHREADVAR').typedef;
  732. exit;
  733. end;
  734. if jvmimplicitpointertype(def) then
  735. begin
  736. result:=search_system_type('FPCIMPLICITPTRTHREADVAR').typedef;
  737. exit;
  738. end;
  739. case def.typ of
  740. orddef:
  741. begin
  742. case torddef(def).ordtype of
  743. pasbool1,
  744. pasbool8:
  745. begin
  746. result:=tobjectdef(search_system_type('FPCBOOLEANTHREADVAR').typedef);
  747. end;
  748. uwidechar:
  749. begin
  750. result:=tobjectdef(search_system_type('FPCCHARTHREADVAR').typedef);
  751. end;
  752. s8bit,
  753. u8bit,
  754. uchar,
  755. bool8bit:
  756. begin
  757. result:=tobjectdef(search_system_type('FPCBYTETHREADVAR').typedef);
  758. end;
  759. s16bit,
  760. u16bit,
  761. bool16bit,
  762. pasbool16:
  763. begin
  764. result:=tobjectdef(search_system_type('FPCSHORTTHREADVAR').typedef);
  765. end;
  766. s32bit,
  767. u32bit,
  768. bool32bit,
  769. pasbool32:
  770. begin
  771. result:=tobjectdef(search_system_type('FPCINTTHREADVAR').typedef);
  772. end;
  773. s64bit,
  774. u64bit,
  775. scurrency,
  776. bool64bit,
  777. pasbool64:
  778. begin
  779. result:=tobjectdef(search_system_type('FPCLONGTHREADVAR').typedef);
  780. end
  781. else
  782. internalerror(2011082101);
  783. end;
  784. end;
  785. floatdef:
  786. begin
  787. case tfloatdef(def).floattype of
  788. s32real:
  789. begin
  790. result:=tobjectdef(search_system_type('FPCFLOATTHREADVAR').typedef);
  791. end;
  792. s64real:
  793. begin
  794. result:=tobjectdef(search_system_type('FPCDOUBLETHREADVAR').typedef);
  795. end;
  796. else
  797. internalerror(2011082102);
  798. end;
  799. end
  800. else
  801. begin
  802. result:=search_system_type('FPCPOINTERTHREADVAR').typedef
  803. end;
  804. end;
  805. end;
  806. procedure jvmgetarraydimdef(arrdef: tdef; out eledef: tdef; out ndim: longint);
  807. begin
  808. eledef:=arrdef;
  809. ndim:=0;
  810. repeat
  811. eledef:=tarraydef(eledef).elementdef;
  812. inc(ndim);
  813. until (eledef.typ<>arraydef) or
  814. is_dynamic_array(eledef);
  815. end;
  816. function jvmmangledbasename(sym: tsym; const usesymname: TSymStr; withsignature: boolean): TSymStr;
  817. var
  818. container: tsymtable;
  819. vsym: tabstractvarsym;
  820. csym: tconstsym;
  821. usedef: tdef;
  822. begin
  823. case sym.typ of
  824. staticvarsym,
  825. paravarsym,
  826. localvarsym,
  827. fieldvarsym:
  828. begin
  829. vsym:=tabstractvarsym(sym);
  830. { for local and paravarsyms that are unsigned 8/16 bit, change the
  831. outputted type to signed 16/32 bit:
  832. a) the stack slots are all 32 bit anyway, so the storage allocation
  833. is still correct
  834. b) since at the JVM level all types are signed, this makes sure
  835. that the values in the stack slots are valid for the specified
  836. types
  837. }
  838. usedef:=vsym.vardef;
  839. if vsym.typ in [localvarsym,paravarsym] then
  840. begin
  841. if (usedef.typ=orddef) then
  842. case torddef(usedef).ordtype of
  843. u8bit,uchar:
  844. usedef:=s16inttype;
  845. u16bit:
  846. usedef:=s32inttype;
  847. else
  848. ;
  849. end;
  850. end;
  851. result:=jvmencodetype(usedef,false);
  852. if withsignature and
  853. jvmtypeneedssignature(usedef) then
  854. begin
  855. result:=result+' signature "';
  856. result:=result+jvmencodetype(usedef,true)+'"';
  857. end;
  858. if (vsym.typ=paravarsym) and
  859. (vo_is_self in tparavarsym(vsym).varoptions) then
  860. result:='''this'' ' +result
  861. else if (vsym.typ in [paravarsym,localvarsym]) and
  862. ([vo_is_funcret,vo_is_result] * tabstractnormalvarsym(vsym).varoptions <> []) then
  863. result:='''result'' '+result
  864. else
  865. begin
  866. { add array indirection if required }
  867. if (vsym.typ=paravarsym) and
  868. ((usedef.typ=formaldef) or
  869. ((vsym.varspez in [vs_var,vs_out,vs_constref]) and
  870. not jvmimplicitpointertype(usedef))) then
  871. result:='['+result;
  872. { single quotes for definitions to prevent clashes with Java
  873. opcodes }
  874. if withsignature then
  875. result:=usesymname+''' '+result
  876. else
  877. result:=usesymname+' '+result;
  878. { we have to mangle staticvarsyms in localsymtables to
  879. prevent name clashes... }
  880. if (vsym.typ=staticvarsym) then
  881. begin
  882. container:=sym.Owner;
  883. while (container.symtabletype=localsymtable) do
  884. begin
  885. if tdef(container.defowner).typ<>procdef then
  886. internalerror(2011040303);
  887. { unique_id_str is added to prevent problem with overloads }
  888. result:=tprocdef(container.defowner).procsym.realname+'$$'+tprocdef(container.defowner).unique_id_str+'$'+result;
  889. container:=container.defowner.owner;
  890. end;
  891. end;
  892. if withsignature then
  893. result:=''''+result
  894. end;
  895. end;
  896. constsym:
  897. begin
  898. csym:=tconstsym(sym);
  899. { some constants can be untyped }
  900. if assigned(csym.constdef) and
  901. not(csym.consttyp in [constwstring,conststring]) then
  902. begin
  903. result:=jvmencodetype(csym.constdef,false);
  904. if withsignature and
  905. jvmtypeneedssignature(csym.constdef) then
  906. begin
  907. result:=result+' signature "';
  908. result:=result+jvmencodetype(csym.constdef,true)+'"';
  909. end;
  910. end
  911. else
  912. begin
  913. case csym.consttyp of
  914. constord:
  915. result:=jvmencodetype(s32inttype,withsignature);
  916. constreal:
  917. result:=jvmencodetype(s64floattype,withsignature);
  918. constset:
  919. internalerror(2011040701);
  920. constpointer,
  921. constnil:
  922. result:=jvmencodetype(java_jlobject,withsignature);
  923. constwstring,
  924. conststring:
  925. result:=jvmencodetype(java_jlstring,withsignature);
  926. constresourcestring:
  927. internalerror(2011040702);
  928. else
  929. internalerror(2011040703);
  930. end;
  931. end;
  932. if withsignature then
  933. result:=''''+usesymname+''' '+result
  934. else
  935. result:=usesymname+' '+result
  936. end;
  937. else
  938. internalerror(2011021703);
  939. end;
  940. end;
  941. function jvmmangledbasename(sym: tsym; withsignature: boolean): TSymStr;
  942. begin
  943. if (sym.typ=fieldvarsym) and
  944. assigned(tfieldvarsym(sym).externalname) then
  945. result:=jvmmangledbasename(sym,tfieldvarsym(sym).externalname^,withsignature)
  946. else if (sym.typ=staticvarsym) and
  947. (tstaticvarsym(sym).mangledbasename<>'') then
  948. result:=jvmmangledbasename(sym,tstaticvarsym(sym).mangledbasename,withsignature)
  949. else
  950. result:=jvmmangledbasename(sym,sym.RealName,withsignature);
  951. end;
  952. {******************************************************************
  953. jvm type validity checking
  954. *******************************************************************}
  955. function jvmencodetype(def: tdef; withsignature: boolean): TSymStr;
  956. var
  957. errordef: tdef;
  958. begin
  959. if not jvmtryencodetype(def,result,withsignature,errordef) then
  960. internalerror(2011012305);
  961. end;
  962. function jvmchecktype(def: tdef; out founderror: tdef): boolean;
  963. var
  964. encodedtype: TSymStr;
  965. begin
  966. { don't duplicate the code like in objcdef, since the resulting strings
  967. are much shorter here so it's not worth it }
  968. result:=jvmtryencodetype(def,encodedtype,false,founderror);
  969. end;
  970. {******************************************************************
  971. Adding extra methods
  972. *******************************************************************}
  973. procedure maybe_add_public_default_java_constructor(obj: tabstractrecorddef);
  974. var
  975. sym: tsym;
  976. ps: tprocsym;
  977. pd: tprocdef;
  978. topowner: tdefentry;
  979. i: longint;
  980. sstate: tscannerstate;
  981. needclassconstructor: boolean;
  982. begin
  983. ps:=nil;
  984. { if there is at least one constructor for a class, do nothing (for
  985. records, we'll always also need a parameterless constructor) }
  986. if not is_javaclass(obj) or
  987. not (oo_has_constructor in obj.objectoptions) then
  988. begin
  989. { check whether the parent has a parameterless constructor that we can
  990. call (in case of a class; all records will derive from
  991. java.lang.Object or a shim on top of that with a parameterless
  992. constructor) }
  993. if is_javaclass(obj) then
  994. begin
  995. pd:=nil;
  996. { childof may not be assigned in case of a parser error }
  997. if not assigned(tobjectdef(obj).childof) then
  998. exit;
  999. sym:=tsym(tobjectdef(obj).childof.symtable.find('CREATE'));
  1000. if assigned(sym) and
  1001. (sym.typ=procsym) then
  1002. pd:=tprocsym(sym).find_bytype_parameterless(potype_constructor);
  1003. if not assigned(pd) then
  1004. begin
  1005. Message(sym_e_no_matching_inherited_parameterless_constructor);
  1006. exit
  1007. end;
  1008. end;
  1009. { we call all constructors CREATE, because they don't have a name in
  1010. Java and otherwise we can't determine whether multiple overloads
  1011. are created with the same parameters }
  1012. sym:=tsym(obj.symtable.find('CREATE'));
  1013. if assigned(sym) then
  1014. begin
  1015. { does another, non-procsym, symbol already exist with that name? }
  1016. if (sym.typ<>procsym) then
  1017. begin
  1018. Message1(sym_e_duplicate_id_create_java_constructor,sym.realname);
  1019. exit;
  1020. end;
  1021. ps:=tprocsym(sym);
  1022. { is there already a parameterless function/procedure create? }
  1023. pd:=ps.find_bytype_parameterless(potype_function);
  1024. if not assigned(pd) then
  1025. pd:=ps.find_bytype_parameterless(potype_procedure);
  1026. if assigned(pd) then
  1027. begin
  1028. Message1(sym_e_duplicate_id_create_java_constructor,pd.fullprocname(false));
  1029. exit;
  1030. end;
  1031. end;
  1032. if not assigned(sym) then
  1033. begin
  1034. ps:=cprocsym.create('Create');
  1035. obj.symtable.insert(ps);
  1036. end;
  1037. { determine symtable level }
  1038. topowner:=obj;
  1039. while not(topowner.owner.symtabletype in [staticsymtable,globalsymtable]) do
  1040. topowner:=topowner.owner.defowner;
  1041. { create procdef }
  1042. pd:=cprocdef.create(topowner.owner.symtablelevel+1,true);
  1043. if df_generic in obj.defoptions then
  1044. include(pd.defoptions,df_generic);
  1045. { method of this objectdef }
  1046. pd.struct:=obj;
  1047. { associated procsym }
  1048. pd.procsym:=ps;
  1049. { constructor }
  1050. pd.proctypeoption:=potype_constructor;
  1051. { needs to be exported }
  1052. include(pd.procoptions,po_global);
  1053. { by default do not include this routine when looking for overloads }
  1054. include(pd.procoptions,po_ignore_for_overload_resolution);
  1055. { generate anonymous inherited call in the implementation }
  1056. pd.synthetickind:=tsk_anon_inherited;
  1057. { public }
  1058. pd.visibility:=vis_public;
  1059. { result type }
  1060. pd.returndef:=obj;
  1061. { calling convention }
  1062. if assigned(current_structdef) or
  1063. (assigned(pd.owner.defowner) and
  1064. (pd.owner.defowner.typ=recorddef)) then
  1065. handle_calling_convention(pd,hcc_default_actions_intf_struct)
  1066. else
  1067. handle_calling_convention(pd,hcc_default_actions_intf);
  1068. { register forward declaration with procsym }
  1069. proc_add_definition(pd);
  1070. end;
  1071. { also add class constructor if class fields that need wrapping, and
  1072. if none was defined }
  1073. if obj.find_procdef_bytype(potype_class_constructor)=nil then
  1074. begin
  1075. needclassconstructor:=false;
  1076. for i:=0 to obj.symtable.symlist.count-1 do
  1077. begin
  1078. if (tsym(obj.symtable.symlist[i]).typ=staticvarsym) and
  1079. jvmimplicitpointertype(tstaticvarsym(obj.symtable.symlist[i]).vardef) then
  1080. begin
  1081. needclassconstructor:=true;
  1082. break;
  1083. end;
  1084. end;
  1085. if needclassconstructor then
  1086. begin
  1087. replace_scanner('custom_class_constructor',sstate);
  1088. if str_parse_method_dec('constructor fpc_jvm_class_constructor;',potype_class_constructor,true,obj,pd) then
  1089. pd.synthetickind:=tsk_empty
  1090. else
  1091. internalerror(2011040501);
  1092. restore_scanner(sstate);
  1093. end;
  1094. end;
  1095. end;
  1096. end.