2
0

jvmdef.pas 41 KB

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