pjvm.pas 33 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724
  1. {
  2. Copyright (c) 2011 by Jonas Maebe
  3. This unit implements some JVM parser helper routines.
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. {$i fpcdefs.inc}
  18. unit pjvm;
  19. interface
  20. uses
  21. globtype,
  22. symconst,symtype,symbase,symdef,symsym;
  23. { records are emulated via Java classes. They require a default constructor
  24. to initialise temps, a deep copy helper for assignments, and clone()
  25. to initialse dynamic arrays }
  26. procedure add_java_default_record_methods_intf(def: trecorddef);
  27. procedure jvm_maybe_create_enum_class(const name: TIDString; def: tdef);
  28. procedure jvm_create_procvar_class(const name: TIDString; def: tdef);
  29. procedure jvm_wrap_virtual_class_methods(obj: tobjectdef);
  30. function jvm_add_typed_const_initializer(csym: tconstsym): tstaticvarsym;
  31. function jvm_wrap_method_with_vis(pd: tprocdef; vis: tvisibility): tprocdef;
  32. implementation
  33. uses
  34. cutils,cclasses,
  35. verbose,globals,systems,
  36. fmodule,
  37. parabase,aasmdata,
  38. ngenutil,pparautl,
  39. symtable,symcreat,defcmp,jvmdef,symcpu,nobj,
  40. defutil,paramgr;
  41. procedure add_java_default_record_methods_intf(def: trecorddef);
  42. var
  43. sstate: tscannerstate;
  44. pd: tprocdef;
  45. sym: tsym;
  46. i: longint;
  47. begin
  48. maybe_add_public_default_java_constructor(def);
  49. replace_scanner('record_jvm_helpers',sstate);
  50. { no override, because not supported in records. Only required in case
  51. some of the fields require deep copies (otherwise the default
  52. shallow clone is fine) }
  53. for i:=0 to def.symtable.symlist.count-1 do
  54. begin
  55. sym:=tsym(def.symtable.symlist[i]);
  56. if (sym.typ=fieldvarsym) and
  57. jvmimplicitpointertype(tfieldvarsym(sym).vardef) then
  58. begin
  59. if str_parse_method_dec('function clone: JLObject;',potype_function,false,def,pd) then
  60. pd.synthetickind:=tsk_jvm_clone
  61. else
  62. internalerror(2011032806);
  63. break;
  64. end;
  65. end;
  66. { can't use def.typesym, not yet set at this point }
  67. if not assigned(def.symtable.realname) then
  68. internalerror(2011032803);
  69. if str_parse_method_dec('procedure fpcDeepCopy(result: FpcBaseRecordType);',potype_procedure,false,def,pd) then
  70. begin
  71. pd.synthetickind:=tsk_record_deepcopy;
  72. { can't add to the declaration since record methods can't override;
  73. it is in fact an overriding method, because all records inherit
  74. from a Java base class }
  75. include(pd.procoptions,po_overridingmethod);
  76. end
  77. else
  78. internalerror(2011032807);
  79. if def.needs_inittable then
  80. begin
  81. { 'var' instead of 'out' parameter, because 'out' would trigger
  82. calling the initialize method recursively }
  83. if str_parse_method_dec('procedure fpcInitializeRec;',potype_procedure,false,def,pd) then
  84. pd.synthetickind:=tsk_record_initialize
  85. else
  86. internalerror(2011071711);
  87. end;
  88. restore_scanner(sstate);
  89. end;
  90. procedure setup_for_new_class(const scannername: string; out sstate: tscannerstate; out islocal: boolean; out oldsymtablestack: TSymtablestack);
  91. begin
  92. replace_scanner(scannername,sstate);
  93. oldsymtablestack:=symtablestack;
  94. islocal:=symtablestack.top.symtablelevel>=normal_function_level;
  95. if islocal then
  96. begin
  97. { we cannot add a class local to a procedure -> insert it in the
  98. static symtable. This is not ideal because this means that it will
  99. be saved to the ppu file for no good reason, and loaded again
  100. even though it contains a reference to a type that was never
  101. saved to the ppu file (the locally defined enum type). Since this
  102. alias for the locally defined enumtype is only used while
  103. implementing the class' methods, this is however no problem. }
  104. symtablestack:=symtablestack.getcopyuntil(current_module.localsymtable);
  105. end;
  106. end;
  107. procedure restore_after_new_class(const sstate: tscannerstate; const islocal: boolean; const oldsymtablestack: TSymtablestack);
  108. begin
  109. if islocal then
  110. begin
  111. symtablestack.free;
  112. symtablestack:=oldsymtablestack;
  113. end;
  114. restore_scanner(sstate);
  115. end;
  116. procedure jvm_maybe_create_enum_class(const name: TIDString; def: tdef);
  117. var
  118. vmtbuilder: tvmtbuilder;
  119. arrdef: tarraydef;
  120. arrsym: ttypesym;
  121. juhashmap: tdef;
  122. enumclass: tobjectdef;
  123. pd: tprocdef;
  124. old_current_structdef: tabstractrecorddef;
  125. i: longint;
  126. sym,
  127. aliassym: tstaticvarsym;
  128. fsym: tfieldvarsym;
  129. sstate: tscannerstate;
  130. sl: tpropaccesslist;
  131. temptypesym: ttypesym;
  132. oldsymtablestack: tsymtablestack;
  133. islocal: boolean;
  134. begin
  135. { if it's a subrange type, don't create a new class }
  136. if assigned(tenumdef(def).basedef) then
  137. exit;
  138. setup_for_new_class('jvm_enum_class',sstate,islocal,oldsymtablestack);
  139. { create new class (different internal name than enum to prevent name
  140. clash; at unit level because we don't want its methods to be nested
  141. inside a function in case its a local type) }
  142. enumclass:=cobjectdef.create(odt_javaclass,'$'+current_module.realmodulename^+'$'+name+'$InternEnum$'+def.unique_id_str,java_jlenum,true);
  143. tcpuenumdef(def).classdef:=enumclass;
  144. include(enumclass.objectoptions,oo_is_enum_class);
  145. include(enumclass.objectoptions,oo_is_sealed);
  146. { implement FpcEnumValueObtainable interface }
  147. enumclass.ImplementedInterfaces.add(TImplementedInterface.Create(tobjectdef(search_system_type('FPCENUMVALUEOBTAINABLE').typedef)));
  148. { create an alias for this type inside itself: this way we can choose a
  149. name that can be used in generated Pascal code without risking an
  150. identifier conflict (since it is local to this class; the global name
  151. is unique because it's an identifier that contains $-signs) }
  152. enumclass.symtable.insert(ctypesym.create('__FPC_TEnumClassAlias',enumclass));
  153. { also create an alias for the enum type so that we can iterate over
  154. all enum values when creating the body of the class constructor }
  155. temptypesym:=ctypesym.create('__FPC_TEnumAlias',nil);
  156. { don't pass def to the ttypesym constructor, because then it
  157. will replace the current (real) typesym of that def with the alias }
  158. temptypesym.typedef:=def;
  159. enumclass.symtable.insert(temptypesym);
  160. { but the name of the class as far as the JVM is concerned will match
  161. the enum's original name (the enum type itself won't be output in
  162. any class file, so no conflict there)
  163. name can be empty in case of declaration such as "set of (ea,eb)" }
  164. if not islocal and
  165. (name <> '') then
  166. enumclass.objextname:=stringdup(name)
  167. else
  168. { for local types, use a unique name to prevent conflicts (since such
  169. types are not visible outside the routine anyway, it doesn't matter
  170. }
  171. begin
  172. enumclass.objextname:=stringdup(enumclass.objrealname^);
  173. { also mark it as private (not strict private, because the class
  174. is not a subclass of the unit in which it is declared, so then
  175. the unit's procedures would not be able to use it) }
  176. enumclass.typesym.visibility:=vis_private;
  177. end;
  178. { now add a bunch of extra things to the enum class }
  179. old_current_structdef:=current_structdef;
  180. current_structdef:=enumclass;
  181. symtablestack.push(enumclass.symtable);
  182. { create static fields representing all enums }
  183. for i:=0 to tenumdef(def).symtable.symlist.count-1 do
  184. begin
  185. fsym:=cfieldvarsym.create(tenumsym(tenumdef(def).symtable.symlist[i]).realname,vs_final,enumclass,[]);
  186. enumclass.symtable.insert(fsym);
  187. sym:=make_field_static(enumclass.symtable,fsym);
  188. { add alias for the field representing ordinal(0), for use in
  189. initialization code }
  190. if tenumsym(tenumdef(def).symtable.symlist[i]).value=0 then
  191. begin
  192. aliassym:=cstaticvarsym.create('__FPC_Zero_Initializer',vs_final,enumclass,[vo_is_external]);
  193. enumclass.symtable.insert(aliassym);
  194. aliassym.set_raw_mangledname(sym.mangledname);
  195. end;
  196. end;
  197. { create local "array of enumtype" type for the "values" functionality
  198. (used internally by the JDK) }
  199. arrdef:=carraydef.create(0,tenumdef(def).symtable.symlist.count-1,s32inttype);
  200. arrdef.elementdef:=enumclass;
  201. arrsym:=ctypesym.create('__FPC_TEnumValues',arrdef);
  202. enumclass.symtable.insert(arrsym);
  203. { insert "public static values: array of enumclass" that returns $VALUES.clone()
  204. (rather than a dynamic array and using clone --which we don't support yet for arrays--
  205. simply use a fixed length array and copy it) }
  206. if not str_parse_method_dec('function values: __FPC_TEnumValues;static;',potype_function,true,enumclass,pd) then
  207. internalerror(2011062301);
  208. include(pd.procoptions,po_staticmethod);
  209. pd.synthetickind:=tsk_jvm_enum_values;
  210. { do we have to store the ordinal value separately? (if no jumps, we can
  211. just call the default ordinal() java.lang.Enum function) }
  212. if tenumdef(def).has_jumps then
  213. begin
  214. { add field for the value }
  215. fsym:=cfieldvarsym.create('__fpc_fenumval',vs_final,s32inttype,[]);
  216. enumclass.symtable.insert(fsym);
  217. tobjectsymtable(enumclass.symtable).addfield(fsym,vis_strictprivate);
  218. { add class field with hash table that maps from FPC-declared ordinal value -> enum instance }
  219. juhashmap:=search_system_type('JUHASHMAP').typedef;
  220. fsym:=cfieldvarsym.create('__fpc_ord2enum',vs_final,juhashmap,[]);
  221. enumclass.symtable.insert(fsym);
  222. make_field_static(enumclass.symtable,fsym);
  223. { add custom constructor }
  224. if not str_parse_method_dec('constructor Create(const __fpc_name: JLString; const __fpc_ord, __fpc_initenumval: longint);',potype_constructor,false,enumclass,pd) then
  225. internalerror(2011062401);
  226. pd.synthetickind:=tsk_jvm_enum_jumps_constr;
  227. pd.visibility:=vis_strictprivate;
  228. end
  229. else
  230. begin
  231. { insert "private constructor(string,int,int)" that calls inherited and
  232. initialises the FPC value field }
  233. add_missing_parent_constructors_intf(enumclass,false,vis_strictprivate);
  234. end;
  235. { add instance method to get the enum's value as declared in FPC }
  236. if not str_parse_method_dec('function FPCOrdinal: longint;',potype_function,false,enumclass,pd) then
  237. internalerror(2011062402);
  238. pd.synthetickind:=tsk_jvm_enum_fpcordinal;
  239. { add static class method to convert an ordinal to the corresponding enum }
  240. if not str_parse_method_dec('function FPCValueOf(__fpc_int: longint): __FPC_TEnumClassAlias; static;',potype_function,true,enumclass,pd) then
  241. internalerror(2011062402);
  242. pd.synthetickind:=tsk_jvm_enum_fpcvalueof;
  243. { similar (instance) function for use in set factories; implements FpcEnumValueObtainable interface }
  244. if not str_parse_method_dec('function fpcGenericValueOf(__fpc_int: longint): JLEnum;',potype_function,false,enumclass,pd) then
  245. internalerror(2011062402);
  246. pd.synthetickind:=tsk_jvm_enum_fpcvalueof;
  247. { insert "public static valueOf(string): tenumclass" that returns tenumclass(inherited valueOf(tenumclass,string)) }
  248. if not str_parse_method_dec('function valueOf(const __fpc_str: JLString): __FPC_TEnumClassAlias; static;',potype_function,true,enumclass,pd) then
  249. internalerror(2011062302);
  250. include(pd.procoptions,po_staticmethod);
  251. pd.synthetickind:=tsk_jvm_enum_valueof;
  252. { add instance method to convert an ordinal and an array into a set of
  253. (we always need/can use both in case of subrange types and/or array
  254. -> set type casts) }
  255. if not str_parse_method_dec('function fpcLongToEnumSet(__val: jlong; __setbase, __setsize: jint): JUEnumSet;',potype_function,true,enumclass,pd) then
  256. internalerror(2011070501);
  257. pd.synthetickind:=tsk_jvm_enum_long2set;
  258. if not str_parse_method_dec('function fpcBitSetToEnumSet(const __val: FpcBitSet; __fromsetbase, __tosetbase: jint): JUEnumSet; static;',potype_function,true,enumclass,pd) then
  259. internalerror(2011071004);
  260. pd.synthetickind:=tsk_jvm_enum_bitset2set;
  261. if not str_parse_method_dec('function fpcEnumSetToEnumSet(const __val: JUEnumSet; __fromsetbase, __tosetbase: jint): JUEnumSet; static;',potype_function,true,enumclass,pd) then
  262. internalerror(2011071005);
  263. pd.synthetickind:=tsk_jvm_enum_set2set;
  264. { create array called "$VALUES" that will contain a reference to all
  265. enum instances (JDK convention)
  266. Disable duplicate identifier checking when inserting, because it will
  267. check for a conflict with "VALUES" ($<id> normally means "check for
  268. <id> without uppercasing first"), which will conflict with the
  269. "Values" instance method -- that's also the reason why we insert the
  270. field only now, because we cannot disable duplicate identifier
  271. checking when creating the "Values" method }
  272. fsym:=cfieldvarsym.create('$VALUES',vs_final,arrdef,[]);
  273. fsym.visibility:=vis_strictprivate;
  274. enumclass.symtable.insert(fsym,false);
  275. sym:=make_field_static(enumclass.symtable,fsym);
  276. { alias for accessing the field in generated Pascal code }
  277. sl:=tpropaccesslist.create;
  278. sl.addsym(sl_load,sym);
  279. enumclass.symtable.insert(cabsolutevarsym.create_ref('__fpc_FVALUES',arrdef,sl));
  280. { add initialization of the static class fields created above }
  281. if not str_parse_method_dec('constructor fpc_enum_class_constructor;',potype_class_constructor,true,enumclass,pd) then
  282. internalerror(2011062303);
  283. pd.synthetickind:=tsk_jvm_enum_classconstr;
  284. symtablestack.pop(enumclass.symtable);
  285. vmtbuilder:=TVMTBuilder.Create(enumclass);
  286. vmtbuilder.generate_vmt;
  287. vmtbuilder.free;
  288. restore_after_new_class(sstate,islocal,oldsymtablestack);
  289. current_structdef:=old_current_structdef;
  290. end;
  291. procedure jvm_create_procvar_class_intern(const name: TIDString; def: tdef; force_no_callback_intf: boolean);
  292. var
  293. vmtbuilder: tvmtbuilder;
  294. oldsymtablestack: tsymtablestack;
  295. pvclass,
  296. pvintf: tobjectdef;
  297. temptypesym: ttypesym;
  298. sstate: tscannerstate;
  299. methoddef: tprocdef;
  300. old_current_structdef: tabstractrecorddef;
  301. islocal: boolean;
  302. begin
  303. { inlined definition of procvar -> generate name, derive from
  304. FpcBaseNestedProcVarType, pass nestedfpstruct to constructor and
  305. copy it }
  306. if name='' then
  307. begin
  308. if is_nested_pd(tabstractprocdef(def)) then
  309. internalerror(2011071901);
  310. end;
  311. setup_for_new_class('jvm_pvar_class',sstate,islocal,oldsymtablestack);
  312. { create new class (different internal name than pvar to prevent name
  313. clash; at unit level because we don't want its methods to be nested
  314. inside a function in case its a local type) }
  315. pvclass:=cobjectdef.create(odt_javaclass,'$'+current_module.realmodulename^+'$'+name+'$InternProcvar$'+def.unique_id_str,java_procvarbase,true);
  316. tcpuprocvardef(def).classdef:=pvclass;
  317. include(pvclass.objectoptions,oo_is_sealed);
  318. if df_generic in def.defoptions then
  319. include(pvclass.defoptions,df_generic);
  320. { associate typesym }
  321. pvclass.symtable.insert(ctypesym.create('__FPC_TProcVarClassAlias',pvclass));
  322. { set external name to match procvar type name }
  323. if not islocal then
  324. pvclass.objextname:=stringdup(name)
  325. else
  326. pvclass.objextname:=stringdup(pvclass.objrealname^);
  327. symtablestack.push(pvclass.symtable);
  328. { inherit constructor and keep public }
  329. add_missing_parent_constructors_intf(pvclass,true,vis_public);
  330. { add a method to call the procvar using unwrapped arguments, which
  331. then wraps them and calls through to JLRMethod.invoke }
  332. methoddef:=tprocdef(tprocvardef(def).getcopyas(procdef,pc_bareproc,''));
  333. finish_copied_procdef(methoddef,'invoke',pvclass.symtable,pvclass);
  334. insert_self_and_vmt_para(methoddef);
  335. insert_funcret_para(methoddef);
  336. methoddef.synthetickind:=tsk_jvm_procvar_invoke;
  337. methoddef.calcparas;
  338. { add local alias for the procvartype that we can use when implementing
  339. the invoke method }
  340. temptypesym:=ctypesym.create('__FPC_ProcVarAlias',nil);
  341. { don't pass def to the ttypesym constructor, because then it
  342. will replace the current (real) typesym of that def with the alias }
  343. temptypesym.typedef:=def;
  344. pvclass.symtable.insert(temptypesym);
  345. { in case of a procedure of object, add a nested interface type that
  346. has one method that conforms to the procvartype (with name
  347. procvartypename+'Callback') and an extra constructor that takes
  348. an instance conforming to this interface and which sets up the
  349. procvar by taking the address of its Callback method (convenient to
  350. use from Java code) }
  351. if (po_methodpointer in tprocvardef(def).procoptions) and
  352. not islocal and
  353. not force_no_callback_intf then
  354. begin
  355. pvintf:=cobjectdef.create(odt_interfacejava,'Callback',nil,true);
  356. pvintf.objextname:=stringdup('Callback');
  357. if df_generic in def.defoptions then
  358. include(pvintf.defoptions,df_generic);
  359. { associate typesym }
  360. pvclass.symtable.insert(ctypesym.create('Callback',pvintf));
  361. { add a method prototype matching the procvar (like the invoke
  362. in the procvarclass itself) }
  363. symtablestack.push(pvintf.symtable);
  364. methoddef:=tprocdef(tprocvardef(def).getcopyas(procdef,pc_bareproc,''));
  365. finish_copied_procdef(methoddef,name+'Callback',pvintf.symtable,pvintf);
  366. insert_self_and_vmt_para(methoddef);
  367. insert_funcret_para(methoddef);
  368. { can't be final/static/private/protected, and must be virtual
  369. since it's an interface method }
  370. methoddef.procoptions:=methoddef.procoptions-[po_staticmethod,po_finalmethod];
  371. include(methoddef.procoptions,po_virtualmethod);
  372. methoddef.visibility:=vis_public;
  373. symtablestack.pop(pvintf.symtable);
  374. { add an extra constructor to the procvarclass that takes an
  375. instance of this interface as parameter }
  376. old_current_structdef:=current_structdef;
  377. current_structdef:=pvclass;
  378. if not str_parse_method_dec('constructor Create(__intf:'+pvintf.objextname^+');overload;',potype_constructor,false,pvclass,methoddef) then
  379. internalerror(2011092401);
  380. methoddef.synthetickind:=tsk_jvm_procvar_intconstr;
  381. methoddef.skpara:=def;
  382. current_structdef:=old_current_structdef;
  383. end;
  384. symtablestack.pop(pvclass.symtable);
  385. vmtbuilder:=TVMTBuilder.Create(pvclass);
  386. vmtbuilder.generate_vmt;
  387. vmtbuilder.free;
  388. restore_after_new_class(sstate,islocal,oldsymtablestack);
  389. end;
  390. procedure jvm_create_procvar_class(const name: TIDString; def: tdef);
  391. begin
  392. jvm_create_procvar_class_intern(name,def,false);
  393. end;
  394. procedure jvm_wrap_virtual_class_method(pd: tprocdef);
  395. var
  396. wrapperpd: tprocdef;
  397. wrapperpv: tcpuprocvardef;
  398. typ: ttypesym;
  399. wrappername: shortstring;
  400. begin
  401. if (po_external in pd.procoptions) or
  402. (oo_is_external in pd.struct.objectoptions) then
  403. exit;
  404. { the JVM does not support virtual class methods -> we generate
  405. wrappers with the original name so they can be called normally,
  406. and these wrappers will then perform a dynamic lookup. To enable
  407. calling the class method by its intended name from external Java code,
  408. we have to change its external name so that we give that original
  409. name to the wrapper function -> "switch" the external names around for
  410. the original and wrapper methods }
  411. { replace importname of original procdef }
  412. include(pd.procoptions,po_has_importname);
  413. if not assigned(pd.import_name) then
  414. wrappername:=pd.procsym.realname
  415. else
  416. wrappername:=pd.import_name^;
  417. stringdispose(pd.import_name);
  418. pd.import_name:=stringdup(wrappername+'__fpcvirtualclassmethod__');
  419. { wrapper is part of the same symtable as the original procdef }
  420. symtablestack.push(pd.owner);
  421. { get a copy of the virtual class method }
  422. wrapperpd:=tprocdef(pd.getcopy);
  423. { this one is not virtual nor override }
  424. exclude(wrapperpd.procoptions,po_virtualmethod);
  425. exclude(wrapperpd.procoptions,po_overridingmethod);
  426. { import/external name = name of original class method }
  427. stringdispose(wrapperpd.import_name);
  428. wrapperpd.import_name:=stringdup(wrappername);
  429. include(wrapperpd.procoptions,po_has_importname);
  430. { associate with wrapper procsym (Pascal-level name = wrapper name ->
  431. in callnodes, we will have to replace the calls to virtual class
  432. methods with calls to the wrappers) }
  433. finish_copied_procdef(wrapperpd,pd.import_name^,pd.owner,tabstractrecorddef(pd.owner.defowner));
  434. { we only have to generate the dispatching routine for non-overriding
  435. methods; the overriding ones can use the original one, but generate
  436. a skeleton for that anyway because the overriding one may still
  437. change the visibility (but we can just call the inherited routine
  438. in that case) }
  439. if po_overridingmethod in pd.procoptions then
  440. begin
  441. { by default do not include this routine when looking for overloads }
  442. include(wrapperpd.procoptions,po_ignore_for_overload_resolution);
  443. wrapperpd.synthetickind:=tsk_anon_inherited;
  444. symtablestack.pop(pd.owner);
  445. exit;
  446. end;
  447. { implementation }
  448. wrapperpd.synthetickind:=tsk_jvm_virtual_clmethod;
  449. wrapperpd.skpara:=pd;
  450. { also create procvar type that we can use in the implementation }
  451. wrapperpv:=tcpuprocvardef(pd.getcopyas(procvardef,pc_normal,''));
  452. wrapperpv.calcparas;
  453. { no use in creating a callback wrapper here, this procvar type isn't
  454. for public consumption }
  455. jvm_create_procvar_class_intern('__fpc_virtualclassmethod_pv_t'+wrapperpd.unique_id_str,wrapperpv,true);
  456. { create alias for the procvar type so we can use it in generated
  457. Pascal code }
  458. typ:=ctypesym.create('__fpc_virtualclassmethod_pv_t'+wrapperpd.unique_id_str,wrapperpv);
  459. wrapperpv.classdef.typesym.visibility:=vis_strictprivate;
  460. symtablestack.top.insert(typ);
  461. symtablestack.pop(pd.owner);
  462. end;
  463. procedure jvm_wrap_virtual_constructor(pd: tprocdef);
  464. var
  465. wrapperpd: tprocdef;
  466. begin
  467. { to avoid having to implement procvar-like support for dynamically
  468. invoking constructors, call the constructors from virtual class
  469. methods and replace calls to the constructors with calls to the
  470. virtual class methods -> we can reuse lots of infrastructure }
  471. if (po_external in pd.procoptions) or
  472. (oo_is_external in pd.struct.objectoptions) then
  473. exit;
  474. { wrapper is part of the same symtable as the original procdef }
  475. symtablestack.push(pd.owner);
  476. { get a copy of the constructor }
  477. wrapperpd:=tprocdef(pd.getcopyas(procdef,pc_bareproc,''));
  478. { this one is a class method rather than a constructor }
  479. include(wrapperpd.procoptions,po_classmethod);
  480. wrapperpd.proctypeoption:=potype_function;
  481. wrapperpd.returndef:=tobjectdef(pd.owner.defowner);
  482. { import/external name = name of original constructor (since
  483. constructors don't have names in Java, this won't conflict with the
  484. original constructor definition) }
  485. stringdispose(wrapperpd.import_name);
  486. wrapperpd.import_name:=stringdup(pd.procsym.realname);
  487. { associate with wrapper procsym (Pascal-level name = wrapper name ->
  488. in callnodes, we will have to replace the calls to virtual
  489. constructors with calls to the wrappers) }
  490. finish_copied_procdef(wrapperpd,pd.procsym.realname+'__fpcvirtconstrwrapper__',pd.owner,tabstractrecorddef(pd.owner.defowner));
  491. { since it was a bare copy, insert the self parameter (we can't just
  492. copy the vmt parameter from the constructor, that's different) }
  493. insert_self_and_vmt_para(wrapperpd);
  494. insert_funcret_para(wrapperpd);
  495. wrapperpd.calcparas;
  496. { implementation: call through to the constructor
  497. Exception: if the current class is abstract, do not call the
  498. constructor, since abstract class cannot be constructed (and the
  499. Android verifier does not accept such code, even if it is
  500. unreachable) }
  501. wrapperpd.synthetickind:=tsk_callthrough_nonabstract;
  502. wrapperpd.skpara:=pd;
  503. symtablestack.pop(pd.owner);
  504. { and now wrap this generated virtual static method itself as well }
  505. jvm_wrap_virtual_class_method(wrapperpd);
  506. end;
  507. procedure jvm_wrap_virtual_class_methods(obj: tobjectdef);
  508. var
  509. i: longint;
  510. def: tdef;
  511. begin
  512. { new methods will be inserted while we do this, but since
  513. symtable.deflist.count is evaluated at the start of the loop that
  514. doesn't matter }
  515. for i:=0 to obj.symtable.deflist.count-1 do
  516. begin
  517. def:=tdef(obj.symtable.deflist[i]);
  518. if def.typ<>procdef then
  519. continue;
  520. if [po_classmethod,po_virtualmethod]<=tprocdef(def).procoptions then
  521. jvm_wrap_virtual_class_method(tprocdef(def))
  522. else if (tprocdef(def).proctypeoption=potype_constructor) and
  523. (po_virtualmethod in tprocdef(def).procoptions) then
  524. jvm_wrap_virtual_constructor(tprocdef(def));
  525. end;
  526. end;
  527. function jvm_add_typed_const_initializer(csym: tconstsym): tstaticvarsym;
  528. var
  529. ssym: tstaticvarsym;
  530. esym: tenumsym;
  531. i: longint;
  532. sstate: tscannerstate;
  533. elemdef: tdef;
  534. elemdefname,
  535. conststr: ansistring;
  536. first: boolean;
  537. begin
  538. result:=nil;
  539. esym:=nil;
  540. case csym.constdef.typ of
  541. enumdef:
  542. begin
  543. { make sure we don't emit a definition for this field (we'll do
  544. that for the constsym already) -> mark as external }
  545. ssym:=cstaticvarsym.create(internal_static_field_name(csym.realname),vs_final,csym.constdef,[vo_is_external]);
  546. csym.owner.insert(ssym);
  547. { alias storage to the constsym }
  548. ssym.set_mangledname(csym.realname);
  549. for i:=0 to tenumdef(csym.constdef).symtable.symlist.count-1 do
  550. begin
  551. esym:=tenumsym(tenumdef(csym.constdef).symtable.symlist[i]);
  552. if esym.value=csym.value.valueord.svalue then
  553. break;
  554. esym:=nil;
  555. end;
  556. { can happen in case of explicit typecast from integer constant
  557. to enum type }
  558. if not assigned(esym) then
  559. begin
  560. MessagePos(csym.fileinfo,parser_e_range_check_error);
  561. exit;
  562. end;
  563. replace_scanner('jvm_enum_const',sstate);
  564. str_parse_typedconst(current_asmdata.asmlists[al_typedconsts],esym.name+';',ssym);
  565. restore_scanner(sstate);
  566. result:=ssym;
  567. end;
  568. setdef:
  569. begin
  570. replace_scanner('jvm_set_const',sstate);
  571. { make sure we don't emit a definition for this field (we'll do
  572. that for the constsym already) -> mark as external;
  573. on the other hand, we don't create instances for constsyms in
  574. (or external syms) the program/unit initialization code -> add
  575. vo_has_local_copy to indicate that this should be done after all
  576. (in thlcgjvm.allocate_implicit_structs_for_st_with_base_ref) }
  577. { the constant can be defined in the body of a function and its
  578. def can also belong to that -> will be freed when the function
  579. has been compiler -> insert a copy in the unit's staticsymtable
  580. }
  581. symtablestack.push(current_module.localsymtable);
  582. ssym:=cstaticvarsym.create(internal_static_field_name(csym.realname),vs_final,tsetdef(csym.constdef).getcopy,[vo_is_external,vo_has_local_copy]);
  583. symtablestack.top.insert(ssym);
  584. symtablestack.pop(current_module.localsymtable);
  585. { alias storage to the constsym }
  586. ssym.set_mangledname(csym.realname);
  587. { ensure that we allocate space for global symbols (won't actually
  588. allocate space for this one, since it's external, but for the
  589. constsym) }
  590. cnodeutils.insertbssdata(ssym);
  591. elemdef:=tsetdef(csym.constdef).elementdef;
  592. if not assigned(elemdef) then
  593. begin
  594. internalerror(2011070502);
  595. end
  596. else
  597. begin
  598. elemdefname:=elemdef.typename;
  599. conststr:='[';
  600. first:=true;
  601. for i:=0 to 255 do
  602. if i in pnormalset(csym.value.valueptr)^ then
  603. begin
  604. if not first then
  605. conststr:=conststr+',';
  606. first:=false;
  607. { instead of looking up all enum value names/boolean
  608. names, type cast integers to the required type }
  609. conststr:=conststr+elemdefname+'('+tostr(i)+')';
  610. end;
  611. conststr:=conststr+'];';
  612. end;
  613. str_parse_typedconst(current_asmdata.asmlists[al_typedconsts],conststr,ssym);
  614. restore_scanner(sstate);
  615. result:=ssym;
  616. end;
  617. else
  618. internalerror(2011062701);
  619. end;
  620. end;
  621. function jvm_wrap_method_with_vis(pd: tprocdef; vis: tvisibility): tprocdef;
  622. var
  623. obj: tabstractrecorddef;
  624. visname: string;
  625. begin
  626. obj:=current_structdef;
  627. { if someone gets the idea to add a property to an external class
  628. definition, don't try to wrap it since we cannot add methods to
  629. external classes }
  630. if oo_is_external in obj.objectoptions then
  631. begin
  632. result:=pd;
  633. exit
  634. end;
  635. symtablestack.push(obj.symtable);
  636. result:=tprocdef(pd.getcopy);
  637. result.visibility:=vis;
  638. visname:=visibilityName[vis];
  639. replace(visname,' ','_');
  640. { create a name that is unique amongst all units (start with '$unitname$$') and
  641. unique in this unit (result.unique_id_str) }
  642. finish_copied_procdef(result,'$'+current_module.realmodulename^+'$$'+result.unique_id_str+pd.procsym.realname+'$'+visname,obj.symtable,obj);
  643. { in case the referred method is from an external class }
  644. exclude(result.procoptions,po_external);
  645. { not virtual/override/abstract/... }
  646. result.procoptions:=result.procoptions*[po_classmethod,po_staticmethod,po_varargs,po_public];
  647. result.synthetickind:=tsk_callthrough;
  648. { so we know the name of the routine to call through to }
  649. result.skpara:=pd;
  650. symtablestack.pop(obj.symtable);
  651. end;
  652. end.