jvmdef.pas 41 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169
  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(2011012201);
  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(2011012203);
  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) or
  478. is_conststring_array(def);
  479. filedef,
  480. recorddef,
  481. setdef:
  482. result:=true;
  483. objectdef:
  484. result:=is_object(def);
  485. stringdef :
  486. result:=tstringdef(def).stringtype in [st_shortstring,st_longstring];
  487. procvardef:
  488. result:=not tprocvardef(def).is_addressonly;
  489. else
  490. result:=false;
  491. end;
  492. end;
  493. { mergeints = true means that all integer types are mapped to jllong,
  494. otherwise they are mapped to the closest corresponding type }
  495. procedure jvmgetboxtype(def: tdef; out objdef, paradef: tdef; mergeints: boolean);
  496. begin
  497. case def.typ of
  498. orddef:
  499. begin
  500. case torddef(def).ordtype of
  501. pasbool1,
  502. pasbool8:
  503. begin
  504. objdef:=tobjectdef(search_system_type('JLBOOLEAN').typedef);
  505. paradef:=pasbool8type;
  506. end;
  507. uwidechar:
  508. begin
  509. objdef:=tobjectdef(search_system_type('JLCHARACTER').typedef);
  510. paradef:=cwidechartype;
  511. end;
  512. else
  513. begin
  514. { wrap all integer types into a JLLONG, so that we don't get
  515. errors after returning a byte assigned to a long etc }
  516. if mergeints or
  517. (torddef(def).ordtype in [s64bit,u64bit,scurrency,bool64bit,pasbool64]) then
  518. begin
  519. objdef:=tobjectdef(search_system_type('JLLONG').typedef);
  520. paradef:=s64inttype;
  521. end
  522. else
  523. begin
  524. case torddef(def).ordtype of
  525. s8bit,
  526. u8bit,
  527. uchar,
  528. bool8bit:
  529. begin
  530. objdef:=tobjectdef(search_system_type('JLBYTE').typedef);
  531. paradef:=s8inttype;
  532. end;
  533. s16bit,
  534. u16bit,
  535. bool16bit,
  536. pasbool16:
  537. begin
  538. objdef:=tobjectdef(search_system_type('JLSHORT').typedef);
  539. paradef:=s16inttype;
  540. end;
  541. s32bit,
  542. u32bit,
  543. bool32bit,
  544. pasbool32:
  545. begin
  546. objdef:=tobjectdef(search_system_type('JLINTEGER').typedef);
  547. paradef:=s32inttype;
  548. end;
  549. else
  550. internalerror(2011052101);
  551. end;
  552. end;
  553. end;
  554. end;
  555. end;
  556. floatdef:
  557. begin
  558. case tfloatdef(def).floattype of
  559. s32real:
  560. begin
  561. objdef:=tobjectdef(search_system_type('JLFLOAT').typedef);
  562. paradef:=s32floattype;
  563. end;
  564. s64real:
  565. begin
  566. objdef:=tobjectdef(search_system_type('JLDOUBLE').typedef);
  567. paradef:=s64floattype;
  568. end;
  569. else
  570. internalerror(2011052102);
  571. end;
  572. end;
  573. else
  574. internalerror(2011052103);
  575. end;
  576. end;
  577. function jvmgetunboxmethod(def: tdef): string;
  578. begin
  579. case def.typ of
  580. orddef:
  581. begin
  582. case torddef(def).ordtype of
  583. pasbool1,
  584. pasbool8:
  585. result:='BOOLEANVALUE';
  586. s8bit,
  587. u8bit,
  588. uchar,
  589. bool8bit:
  590. result:='BYTEVALUE';
  591. s16bit,
  592. u16bit,
  593. bool16bit,
  594. pasbool16:
  595. result:='SHORTVALUE';
  596. s32bit,
  597. u32bit,
  598. bool32bit,
  599. pasbool32:
  600. result:='INTVALUE';
  601. s64bit,
  602. u64bit,
  603. scurrency,
  604. bool64bit,
  605. pasbool64:
  606. result:='LONGVALUE';
  607. uwidechar:
  608. result:='CHARVALUE';
  609. else
  610. internalerror(2011071702);
  611. end;
  612. end;
  613. floatdef:
  614. begin
  615. case tfloatdef(def).floattype of
  616. s32real:
  617. result:='FLOATVALUE';
  618. s64real:
  619. result:='DOUBLEVALUE';
  620. else
  621. internalerror(2011071703);
  622. end;
  623. end;
  624. else
  625. internalerror(2011071704);
  626. end;
  627. end;
  628. function jvmgetcorrespondingclassdef(def: tdef): tdef;
  629. var
  630. paradef: tdef;
  631. begin
  632. if def.typ in [orddef,floatdef] then
  633. jvmgetboxtype(def,result,paradef,false)
  634. else
  635. begin
  636. case def.typ of
  637. stringdef :
  638. begin
  639. case tstringdef(def).stringtype of
  640. { translated into java.lang.String }
  641. st_widestring,
  642. st_unicodestring:
  643. result:=java_jlstring;
  644. st_ansistring:
  645. result:=java_ansistring;
  646. st_shortstring:
  647. result:=java_shortstring;
  648. else
  649. internalerror(2011072409);
  650. end;
  651. end;
  652. enumdef:
  653. begin
  654. result:=tcpuenumdef(tenumdef(def).getbasedef).classdef;
  655. end;
  656. pointerdef :
  657. begin
  658. if def=voidpointertype then
  659. result:=java_jlobject
  660. else if jvmimplicitpointertype(tpointerdef(def).pointeddef) then
  661. result:=tpointerdef(def).pointeddef
  662. else
  663. internalerror(2011072410);
  664. end;
  665. recorddef :
  666. begin
  667. result:=def;
  668. end;
  669. variantdef :
  670. begin
  671. result:=cvarianttype;
  672. end;
  673. classrefdef :
  674. begin
  675. result:=search_system_type('JLCLASS').typedef;
  676. end;
  677. setdef :
  678. begin
  679. if tsetdef(def).elementdef.typ=enumdef then
  680. result:=java_juenumset
  681. else
  682. result:=java_jubitset;
  683. end;
  684. formaldef :
  685. begin
  686. result:=java_jlobject;
  687. end;
  688. arraydef :
  689. begin
  690. { cannot represent statically }
  691. internalerror(2011072411);
  692. end;
  693. procvardef :
  694. begin
  695. result:=tcpuprocvardef(def).classdef;
  696. end;
  697. objectdef :
  698. case tobjectdef(def).objecttype of
  699. odt_javaclass,
  700. odt_interfacejava:
  701. result:=def
  702. else
  703. internalerror(2011072412);
  704. end;
  705. else
  706. internalerror(2011072413);
  707. end;
  708. end;
  709. end;
  710. function get_para_push_size(def: tdef): tdef;
  711. begin
  712. result:=def;
  713. if def.typ=orddef then
  714. case torddef(def).ordtype of
  715. u8bit,uchar:
  716. if torddef(def).high>127 then
  717. result:=s8inttype;
  718. u16bit:
  719. begin
  720. if torddef(def).high>32767 then
  721. result:=s16inttype;
  722. end
  723. else
  724. ;
  725. end;
  726. end;
  727. function jvmgetthreadvardef(def: tdef): tdef;
  728. begin
  729. if (def.typ=arraydef) and
  730. not is_dynamic_array(def) then
  731. begin
  732. result:=search_system_type('FPCNORMALARRAYTHREADVAR').typedef;
  733. exit;
  734. end;
  735. if jvmimplicitpointertype(def) then
  736. begin
  737. result:=search_system_type('FPCIMPLICITPTRTHREADVAR').typedef;
  738. exit;
  739. end;
  740. case def.typ of
  741. orddef:
  742. begin
  743. case torddef(def).ordtype of
  744. pasbool1,
  745. pasbool8:
  746. begin
  747. result:=tobjectdef(search_system_type('FPCBOOLEANTHREADVAR').typedef);
  748. end;
  749. uwidechar:
  750. begin
  751. result:=tobjectdef(search_system_type('FPCCHARTHREADVAR').typedef);
  752. end;
  753. s8bit,
  754. u8bit,
  755. uchar,
  756. bool8bit:
  757. begin
  758. result:=tobjectdef(search_system_type('FPCBYTETHREADVAR').typedef);
  759. end;
  760. s16bit,
  761. u16bit,
  762. bool16bit,
  763. pasbool16:
  764. begin
  765. result:=tobjectdef(search_system_type('FPCSHORTTHREADVAR').typedef);
  766. end;
  767. s32bit,
  768. u32bit,
  769. bool32bit,
  770. pasbool32:
  771. begin
  772. result:=tobjectdef(search_system_type('FPCINTTHREADVAR').typedef);
  773. end;
  774. s64bit,
  775. u64bit,
  776. scurrency,
  777. bool64bit,
  778. pasbool64:
  779. begin
  780. result:=tobjectdef(search_system_type('FPCLONGTHREADVAR').typedef);
  781. end
  782. else
  783. internalerror(2011082101);
  784. end;
  785. end;
  786. floatdef:
  787. begin
  788. case tfloatdef(def).floattype of
  789. s32real:
  790. begin
  791. result:=tobjectdef(search_system_type('FPCFLOATTHREADVAR').typedef);
  792. end;
  793. s64real:
  794. begin
  795. result:=tobjectdef(search_system_type('FPCDOUBLETHREADVAR').typedef);
  796. end;
  797. else
  798. internalerror(2011082102);
  799. end;
  800. end
  801. else
  802. begin
  803. result:=search_system_type('FPCPOINTERTHREADVAR').typedef
  804. end;
  805. end;
  806. end;
  807. procedure jvmgetarraydimdef(arrdef: tdef; out eledef: tdef; out ndim: longint);
  808. begin
  809. eledef:=arrdef;
  810. ndim:=0;
  811. repeat
  812. eledef:=tarraydef(eledef).elementdef;
  813. inc(ndim);
  814. until (eledef.typ<>arraydef) or
  815. is_dynamic_array(eledef);
  816. end;
  817. function jvmmangledbasename(sym: tsym; const usesymname: TSymStr; withsignature: boolean): TSymStr;
  818. var
  819. container: tsymtable;
  820. vsym: tabstractvarsym;
  821. csym: tconstsym;
  822. usedef: tdef;
  823. begin
  824. case sym.typ of
  825. staticvarsym,
  826. paravarsym,
  827. localvarsym,
  828. fieldvarsym:
  829. begin
  830. vsym:=tabstractvarsym(sym);
  831. { for local and paravarsyms that are unsigned 8/16 bit, change the
  832. outputted type to signed 16/32 bit:
  833. a) the stack slots are all 32 bit anyway, so the storage allocation
  834. is still correct
  835. b) since at the JVM level all types are signed, this makes sure
  836. that the values in the stack slots are valid for the specified
  837. types
  838. }
  839. usedef:=vsym.vardef;
  840. if vsym.typ in [localvarsym,paravarsym] then
  841. begin
  842. if (usedef.typ=orddef) then
  843. case torddef(usedef).ordtype of
  844. u8bit,uchar:
  845. usedef:=s16inttype;
  846. u16bit:
  847. usedef:=s32inttype;
  848. else
  849. ;
  850. end;
  851. end;
  852. result:=jvmencodetype(usedef,false);
  853. if withsignature and
  854. jvmtypeneedssignature(usedef) then
  855. begin
  856. result:=result+' signature "';
  857. result:=result+jvmencodetype(usedef,true)+'"';
  858. end;
  859. if (vsym.typ=paravarsym) and
  860. (vo_is_self in tparavarsym(vsym).varoptions) then
  861. result:='''this'' ' +result
  862. else if (vsym.typ in [paravarsym,localvarsym]) and
  863. ([vo_is_funcret,vo_is_result] * tabstractnormalvarsym(vsym).varoptions <> []) then
  864. result:='''result'' '+result
  865. else
  866. begin
  867. { add array indirection if required }
  868. if (vsym.typ=paravarsym) and
  869. ((usedef.typ=formaldef) or
  870. ((vsym.varspez in [vs_var,vs_out,vs_constref]) and
  871. not jvmimplicitpointertype(usedef))) then
  872. result:='['+result;
  873. { single quotes for definitions to prevent clashes with Java
  874. opcodes }
  875. if withsignature then
  876. result:=usesymname+''' '+result
  877. else
  878. result:=usesymname+' '+result;
  879. { we have to mangle staticvarsyms in localsymtables to
  880. prevent name clashes... }
  881. if (vsym.typ=staticvarsym) then
  882. begin
  883. container:=sym.Owner;
  884. while (container.symtabletype=localsymtable) do
  885. begin
  886. if tdef(container.defowner).typ<>procdef then
  887. internalerror(2011040303);
  888. { unique_id_str is added to prevent problem with overloads }
  889. result:=tprocdef(container.defowner).procsym.realname+'$$'+tprocdef(container.defowner).unique_id_str+'$'+result;
  890. container:=container.defowner.owner;
  891. end;
  892. end;
  893. if withsignature then
  894. result:=''''+result
  895. end;
  896. end;
  897. constsym:
  898. begin
  899. csym:=tconstsym(sym);
  900. { some constants can be untyped }
  901. if assigned(csym.constdef) and
  902. not(csym.consttyp in [constwstring,conststring]) then
  903. begin
  904. result:=jvmencodetype(csym.constdef,false);
  905. if withsignature and
  906. jvmtypeneedssignature(csym.constdef) then
  907. begin
  908. result:=result+' signature "';
  909. result:=result+jvmencodetype(csym.constdef,true)+'"';
  910. end;
  911. end
  912. else
  913. begin
  914. case csym.consttyp of
  915. constord:
  916. result:=jvmencodetype(s32inttype,withsignature);
  917. constreal:
  918. result:=jvmencodetype(s64floattype,withsignature);
  919. constset:
  920. internalerror(2011040701);
  921. constpointer,
  922. constnil:
  923. result:=jvmencodetype(java_jlobject,withsignature);
  924. constwstring,
  925. conststring:
  926. result:=jvmencodetype(java_jlstring,withsignature);
  927. constresourcestring:
  928. internalerror(2011040702);
  929. else
  930. internalerror(2011040703);
  931. end;
  932. end;
  933. if withsignature then
  934. result:=''''+usesymname+''' '+result
  935. else
  936. result:=usesymname+' '+result
  937. end;
  938. else
  939. internalerror(2011021703);
  940. end;
  941. end;
  942. function jvmmangledbasename(sym: tsym; withsignature: boolean): TSymStr;
  943. begin
  944. if (sym.typ=fieldvarsym) and
  945. assigned(tfieldvarsym(sym).externalname) then
  946. result:=jvmmangledbasename(sym,tfieldvarsym(sym).externalname^,withsignature)
  947. else if (sym.typ=staticvarsym) and
  948. (tstaticvarsym(sym).mangledbasename<>'') then
  949. result:=jvmmangledbasename(sym,tstaticvarsym(sym).mangledbasename,withsignature)
  950. else
  951. result:=jvmmangledbasename(sym,sym.RealName,withsignature);
  952. end;
  953. {******************************************************************
  954. jvm type validity checking
  955. *******************************************************************}
  956. function jvmencodetype(def: tdef; withsignature: boolean): TSymStr;
  957. var
  958. errordef: tdef;
  959. begin
  960. if not jvmtryencodetype(def,result,withsignature,errordef) then
  961. internalerror(2011012305);
  962. end;
  963. function jvmchecktype(def: tdef; out founderror: tdef): boolean;
  964. var
  965. encodedtype: TSymStr;
  966. begin
  967. { don't duplicate the code like in objcdef, since the resulting strings
  968. are much shorter here so it's not worth it }
  969. result:=jvmtryencodetype(def,encodedtype,false,founderror);
  970. end;
  971. {******************************************************************
  972. Adding extra methods
  973. *******************************************************************}
  974. procedure maybe_add_public_default_java_constructor(obj: tabstractrecorddef);
  975. var
  976. sym: tsym;
  977. ps: tprocsym;
  978. pd: tprocdef;
  979. topowner: tdefentry;
  980. i: longint;
  981. sstate: tscannerstate;
  982. needclassconstructor: boolean;
  983. begin
  984. ps:=nil;
  985. { if there is at least one constructor for a class, do nothing (for
  986. records, we'll always also need a parameterless constructor) }
  987. if not is_javaclass(obj) or
  988. not (oo_has_constructor in obj.objectoptions) then
  989. begin
  990. { check whether the parent has a parameterless constructor that we can
  991. call (in case of a class; all records will derive from
  992. java.lang.Object or a shim on top of that with a parameterless
  993. constructor) }
  994. if is_javaclass(obj) then
  995. begin
  996. pd:=nil;
  997. { childof may not be assigned in case of a parser error }
  998. if not assigned(tobjectdef(obj).childof) then
  999. exit;
  1000. sym:=tsym(tobjectdef(obj).childof.symtable.find('CREATE'));
  1001. if assigned(sym) and
  1002. (sym.typ=procsym) then
  1003. pd:=tprocsym(sym).find_bytype_parameterless(potype_constructor);
  1004. if not assigned(pd) then
  1005. begin
  1006. Message(sym_e_no_matching_inherited_parameterless_constructor);
  1007. exit
  1008. end;
  1009. end;
  1010. { we call all constructors CREATE, because they don't have a name in
  1011. Java and otherwise we can't determine whether multiple overloads
  1012. are created with the same parameters }
  1013. sym:=tsym(obj.symtable.find('CREATE'));
  1014. if assigned(sym) then
  1015. begin
  1016. { does another, non-procsym, symbol already exist with that name? }
  1017. if (sym.typ<>procsym) then
  1018. begin
  1019. Message1(sym_e_duplicate_id_create_java_constructor,sym.realname);
  1020. exit;
  1021. end;
  1022. ps:=tprocsym(sym);
  1023. { is there already a parameterless function/procedure create? }
  1024. pd:=ps.find_bytype_parameterless(potype_function);
  1025. if not assigned(pd) then
  1026. pd:=ps.find_bytype_parameterless(potype_procedure);
  1027. if assigned(pd) then
  1028. begin
  1029. Message1(sym_e_duplicate_id_create_java_constructor,pd.fullprocname(false));
  1030. exit;
  1031. end;
  1032. end;
  1033. if not assigned(sym) then
  1034. begin
  1035. ps:=cprocsym.create('Create');
  1036. obj.symtable.insert(ps);
  1037. end;
  1038. { determine symtable level }
  1039. topowner:=obj;
  1040. while not(topowner.owner.symtabletype in [staticsymtable,globalsymtable]) do
  1041. topowner:=topowner.owner.defowner;
  1042. { create procdef }
  1043. pd:=cprocdef.create(topowner.owner.symtablelevel+1,true);
  1044. if df_generic in obj.defoptions then
  1045. include(pd.defoptions,df_generic);
  1046. { method of this objectdef }
  1047. pd.struct:=obj;
  1048. { associated procsym }
  1049. pd.procsym:=ps;
  1050. { constructor }
  1051. pd.proctypeoption:=potype_constructor;
  1052. { needs to be exported }
  1053. include(pd.procoptions,po_global);
  1054. { by default do not include this routine when looking for overloads }
  1055. include(pd.procoptions,po_ignore_for_overload_resolution);
  1056. { generate anonymous inherited call in the implementation }
  1057. pd.synthetickind:=tsk_anon_inherited;
  1058. { public }
  1059. pd.visibility:=vis_public;
  1060. { result type }
  1061. pd.returndef:=obj;
  1062. { calling convention }
  1063. if assigned(current_structdef) or
  1064. (assigned(pd.owner.defowner) and
  1065. (pd.owner.defowner.typ=recorddef)) then
  1066. handle_calling_convention(pd,hcc_default_actions_intf_struct)
  1067. else
  1068. handle_calling_convention(pd,hcc_default_actions_intf);
  1069. { register forward declaration with procsym }
  1070. proc_add_definition(pd);
  1071. end;
  1072. { also add class constructor if class fields that need wrapping, and
  1073. if none was defined }
  1074. if obj.find_procdef_bytype(potype_class_constructor)=nil then
  1075. begin
  1076. needclassconstructor:=false;
  1077. for i:=0 to obj.symtable.symlist.count-1 do
  1078. begin
  1079. if (tsym(obj.symtable.symlist[i]).typ=staticvarsym) and
  1080. jvmimplicitpointertype(tstaticvarsym(obj.symtable.symlist[i]).vardef) then
  1081. begin
  1082. needclassconstructor:=true;
  1083. break;
  1084. end;
  1085. end;
  1086. if needclassconstructor then
  1087. begin
  1088. replace_scanner('custom_class_constructor',sstate);
  1089. if str_parse_method_dec('constructor fpc_jvm_class_constructor;',potype_class_constructor,true,obj,pd) then
  1090. pd.synthetickind:=tsk_empty
  1091. else
  1092. internalerror(2011040501);
  1093. restore_scanner(sstate);
  1094. end;
  1095. end;
  1096. end;
  1097. end.