symcpu.pas 26 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770
  1. {
  2. Copyright (c) 2014 by Florian Klaempfl
  3. Symbol table overrides for WebAssembly
  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. unit symcpu;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. globtype,
  22. aasmdata,
  23. symtype,
  24. symdef,symsym;
  25. type
  26. { defs }
  27. tcpufiledef = class(tfiledef)
  28. end;
  29. tcpufiledefclass = class of tcpufiledef;
  30. tcpuvariantdef = class(tvariantdef)
  31. end;
  32. tcpuvariantdefclass = class of tcpuvariantdef;
  33. tcpuformaldef = class(tformaldef)
  34. end;
  35. tcpuformaldefclass = class of tcpuformaldef;
  36. tcpuforwarddef = class(tforwarddef)
  37. end;
  38. tcpuforwarddefclass = class of tcpuforwarddef;
  39. tcpuundefineddef = class(tundefineddef)
  40. end;
  41. tcpuundefineddefclass = class of tcpuundefineddef;
  42. tcpuerrordef = class(terrordef)
  43. end;
  44. tcpuerrordefclass = class of tcpuerrordef;
  45. tcpupointerdef = class(tpointerdef)
  46. end;
  47. tcpupointerdefclass = class of tcpupointerdef;
  48. tcpurecorddef = class(trecorddef)
  49. end;
  50. tcpurecorddefclass = class of tcpurecorddef;
  51. tcpuimplementedinterface = class(timplementedinterface)
  52. end;
  53. tcpuimplementedinterfaceclass = class of tcpuimplementedinterface;
  54. tcpuobjectdef = class(tobjectdef)
  55. end;
  56. tcpuobjectdefclass = class of tcpuobjectdef;
  57. tcpuclassrefdef = class(tclassrefdef)
  58. end;
  59. tcpuclassrefdefclass = class of tcpuclassrefdef;
  60. tcpuarraydef = class(tarraydef)
  61. end;
  62. tcpuarraydefclass = class of tcpuarraydef;
  63. tcpuorddef = class(torddef)
  64. end;
  65. tcpuorddefclass = class of tcpuorddef;
  66. tcpufloatdef = class(tfloatdef)
  67. end;
  68. tcpufloatdefclass = class of tcpufloatdef;
  69. tcpuprocvardef = class(tprocvardef)
  70. protected
  71. procedure ppuwrite_platform(ppufile: tcompilerppufile); override;
  72. procedure ppuload_platform(ppufile: tcompilerppufile); override;
  73. public
  74. { class representing this procvar on the Java side }
  75. classdef : tobjectdef;
  76. classdefderef : tderef;
  77. procedure buildderef;override;
  78. procedure deref;override;
  79. function getcopy: tstoreddef; override;
  80. end;
  81. tcpuprocvardefclass = class of tcpuprocvardef;
  82. tcpuprocdef = class(tprocdef)
  83. { generated assembler code; used by WebAssembly backend so it can afterwards
  84. easily write out all methods grouped per class }
  85. exprasmlist : TAsmList;
  86. function getfuncretsyminfo(out ressym: tsym; out resdef: tdef): boolean; override;
  87. destructor destroy; override;
  88. end;
  89. tcpuprocdefclass = class of tcpuprocdef;
  90. tcpustringdef = class(tstringdef)
  91. end;
  92. tcpustringdefclass = class of tcpustringdef;
  93. tcpuenumdef = class(tenumdef)
  94. protected
  95. procedure ppuload_platform(ppufile: tcompilerppufile); override;
  96. procedure ppuwrite_platform(ppufile: tcompilerppufile); override;
  97. public
  98. { class representing this enum on the Java side }
  99. classdef : tobjectdef;
  100. classdefderef : tderef;
  101. function getcopy: tstoreddef; override;
  102. procedure buildderef; override;
  103. procedure deref; override;
  104. end;
  105. tcpuenumdefclass = class of tcpuenumdef;
  106. tcpusetdef = class(tsetdef)
  107. end;
  108. tcpusetdefclass = class of tcpusetdef;
  109. { syms }
  110. tcpulabelsym = class(tlabelsym)
  111. end;
  112. tcpulabelsymclass = class of tcpulabelsym;
  113. tcpuunitsym = class(tunitsym)
  114. end;
  115. tcpuunitsymclass = class of tcpuunitsym;
  116. tcpuprogramparasym = class(tprogramparasym)
  117. end;
  118. tcpuprogramparasymclass = class(tprogramparasym);
  119. tcpunamespacesym = class(tnamespacesym)
  120. end;
  121. tcpunamespacesymclass = class of tcpunamespacesym;
  122. tcpuprocsym = class(tprocsym)
  123. procedure check_forward; override;
  124. end;
  125. tcpuprocsymclass = class of tcpuprocsym;
  126. tcputypesym = class(ttypesym)
  127. end;
  128. tcpuypesymclass = class of tcputypesym;
  129. tcpufieldvarsym = class(tfieldvarsym)
  130. end;
  131. tcpufieldvarsymclass = class of tcpufieldvarsym;
  132. tcpulocalvarsym = class(tlocalvarsym)
  133. end;
  134. tcpulocalvarsymclass = class of tcpulocalvarsym;
  135. tcpuparavarsym = class(tparavarsym)
  136. end;
  137. tcpuparavarsymclass = class of tcpuparavarsym;
  138. tcpustaticvarsym = class(tstaticvarsym)
  139. end;
  140. tcpustaticvarsymclass = class of tcpustaticvarsym;
  141. tcpuabsolutevarsym = class(tabsolutevarsym)
  142. end;
  143. tcpuabsolutevarsymclass = class of tcpuabsolutevarsym;
  144. tcpupropertysym = class(tpropertysym)
  145. protected
  146. { when a private/protected field is exposed via a property with a higher
  147. visibility, then we have to create a getter and/or setter with that same
  148. higher visibility to make sure that using the property does not result
  149. in JVM verification errors }
  150. procedure create_getter_or_setter_for_property(orgaccesspd: tprocdef; getter: boolean);
  151. procedure finalize_getter_or_setter_for_sym(getset: tpropaccesslisttypes; sym: tsym; fielddef: tdef; accessordef: tprocdef); override;
  152. procedure maybe_create_overridden_getter_or_setter(getset: tpropaccesslisttypes);
  153. public
  154. procedure inherit_accessor(getset: tpropaccesslisttypes); override;
  155. end;
  156. tcpupropertysymclass = class of tcpupropertysym;
  157. tcpuconstsym = class(tconstsym)
  158. end;
  159. tcpuconstsymclass = class of tcpuconstsym;
  160. tcpuenumsym = class(tenumsym)
  161. end;
  162. tcpuenumsymclass = class of tcpuenumsym;
  163. tcpusyssym = class(tsyssym)
  164. end;
  165. tcpusyssymclass = class of tcpusyssym;
  166. const
  167. pbestrealtype : ^tdef = @s64floattype;
  168. implementation
  169. uses
  170. verbose,cutils,cclasses,globals,
  171. symconst,symbase,symtable,symcreat,wasmdef,
  172. pdecsub,pparautl,{pjvm,}
  173. paramgr;
  174. {****************************************************************************
  175. tcpuproptertysym
  176. ****************************************************************************}
  177. procedure tcpupropertysym.create_getter_or_setter_for_property(orgaccesspd: tprocdef; getter: boolean);
  178. var
  179. obj: tabstractrecorddef;
  180. ps: tprocsym;
  181. pvs: tparavarsym;
  182. sym: tsym;
  183. pd, parentpd, accessorparapd: tprocdef;
  184. tmpaccesslist: tpropaccesslist;
  185. callthroughpropname,
  186. accessorname: string;
  187. callthroughprop: tpropertysym;
  188. accesstyp: tpropaccesslisttypes;
  189. accessortyp: tprocoption;
  190. procoptions: tprocoptions;
  191. paranr: word;
  192. explicitwrapper: boolean;
  193. begin
  194. obj:=current_structdef;
  195. { if someone gets the idea to add a property to an external class
  196. definition, don't try to wrap it since we cannot add methods to
  197. external classes }
  198. if oo_is_external in obj.objectoptions then
  199. exit;
  200. symtablestack.push(obj.symtable);
  201. try
  202. if getter then
  203. accesstyp:=palt_read
  204. else
  205. accesstyp:=palt_write;
  206. { we can't use str_parse_method_dec here because the type of the field
  207. may not be visible at the Pascal level }
  208. explicitwrapper:=
  209. { private methods are not visibile outside the current class, so
  210. no use in making life harder for us by introducing potential
  211. (future or current) naming conflicts }
  212. (visibility<>vis_private) and
  213. (getter and
  214. (prop_auto_getter_prefix<>'')) or
  215. (not getter and
  216. (prop_auto_setter_prefix<>''));
  217. sym:=nil;
  218. if getter then
  219. accessortyp:=po_is_auto_getter
  220. else
  221. accessortyp:=po_is_auto_setter;
  222. procoptions:=[accessortyp];
  223. if explicitwrapper then
  224. begin
  225. if getter then
  226. accessorname:=prop_auto_getter_prefix+realname
  227. else
  228. accessorname:=prop_auto_setter_prefix+realname;
  229. sym:=search_struct_member_no_helper(obj,upper(accessorname));
  230. if assigned(sym) then
  231. begin
  232. if ((sym.typ<>procsym) or
  233. (tprocsym(sym).procdeflist.count<>1) or
  234. not(accessortyp in tprocdef(tprocsym(sym).procdeflist[0]).procoptions)) and
  235. (not assigned(orgaccesspd) or
  236. (sym<>orgaccesspd.procsym)) then
  237. begin
  238. MessagePos2(fileinfo,parser_e_cannot_generate_property_getter_setter,accessorname,FullTypeName(tdef(sym.owner.defowner),nil)+'.'+accessorname);
  239. exit;
  240. end
  241. else
  242. begin
  243. if accessorname<>sym.realname then
  244. MessagePos2(fileinfo,parser_w_case_difference_auto_property_getter_setter_prefix,sym.realname,accessorname);
  245. { is the specified getter/setter defined in the current
  246. struct and was it originally specified as the getter/
  247. setter for this property? If so, simply adjust its
  248. visibility if necessary.
  249. }
  250. if assigned(orgaccesspd) then
  251. parentpd:=orgaccesspd
  252. else
  253. parentpd:=tprocdef(tprocsym(sym).procdeflist[0]);
  254. if parentpd.owner.defowner=owner.defowner then
  255. begin
  256. if parentpd.visibility<visibility then
  257. begin
  258. parentpd.visibility:=visibility;
  259. include(parentpd.procoptions,po_auto_raised_visibility);
  260. end;
  261. { we are done, no need to create a wrapper }
  262. exit
  263. end
  264. { a parent already included this getter/setter -> try to
  265. override it }
  266. else if parentpd.visibility<>vis_private then
  267. begin
  268. if po_virtualmethod in parentpd.procoptions then
  269. begin
  270. procoptions:=procoptions+[po_virtualmethod,po_overridingmethod];
  271. if not(parentpd.synthetickind in [tsk_field_getter,tsk_field_setter]) then
  272. Message2(parser_w_overriding_property_getter_setter,accessorname,FullTypeName(tdef(parentpd.owner.defowner),nil));
  273. end;
  274. { otherwise we can't do anything, and
  275. proc_add_definition will give an error }
  276. end;
  277. { add method with the correct visibility }
  278. pd:=tprocdef(parentpd.getcopyas(procdef,pc_normal_no_hidden,''));
  279. { get rid of the import accessorname for inherited virtual class methods,
  280. it has to be regenerated rather than amended }
  281. if [po_classmethod,po_virtualmethod]<=pd.procoptions then
  282. begin
  283. stringdispose(pd.import_name);
  284. exclude(pd.procoptions,po_has_importname);
  285. end;
  286. pd.visibility:=visibility;
  287. pd.procoptions:=pd.procoptions+procoptions;
  288. { ignore this artificially added procdef when looking for overloads }
  289. include(pd.procoptions,po_ignore_for_overload_resolution);
  290. finish_copied_procdef(pd,parentpd.procsym.realname,obj.symtable,obj);
  291. exclude(pd.procoptions,po_external);
  292. pd.synthetickind:=tsk_anon_inherited;
  293. { set the accessor in the property }
  294. propaccesslist[accesstyp].clear;
  295. propaccesslist[accesstyp].addsym(sl_call,pd.procsym);
  296. propaccesslist[accesstyp].procdef:=pd;
  297. exit;
  298. end;
  299. end;
  300. { make the artificial getter/setter virtual so we can override it in
  301. children if necessary }
  302. if not(sp_static in symoptions) and
  303. (obj.typ=objectdef) then
  304. include(procoptions,po_virtualmethod);
  305. { prevent problems in Delphi mode }
  306. include(procoptions,po_overload);
  307. end
  308. else
  309. begin
  310. { construct procsym accessorname (unique for this access; reusing the same
  311. helper for multiple accesses to the same field is hard because the
  312. propacesslist can contain subscript nodes etc) }
  313. accessorname:=visibilityName[visibility];
  314. replace(accessorname,' ','_');
  315. if getter then
  316. accessorname:=accessorname+'$getter'
  317. else
  318. accessorname:=accessorname+'$setter';
  319. end;
  320. { create procdef }
  321. if not assigned(orgaccesspd) then
  322. begin
  323. pd:=cprocdef.create(normal_function_level,true);
  324. if df_generic in obj.defoptions then
  325. include(pd.defoptions,df_generic);
  326. { method of this objectdef }
  327. pd.struct:=obj;
  328. { can only construct the artificial accessorname now, because it requires
  329. pd.unique_id_str }
  330. if not explicitwrapper then
  331. accessorname:='$'+obj.symtable.realname^+'$'+realname+'$'+accessorname+'$'+pd.unique_id_str;
  332. end
  333. else
  334. begin
  335. { getter/setter could have parameters in case of indexed access
  336. -> copy original procdef }
  337. pd:=tprocdef(orgaccesspd.getcopyas(procdef,pc_normal_no_hidden,''));
  338. exclude(pd.procoptions,po_abstractmethod);
  339. exclude(pd.procoptions,po_overridingmethod);
  340. { can only construct the artificial accessorname now, because it requires
  341. pd.unique_id_str }
  342. if not explicitwrapper then
  343. accessorname:='$'+obj.symtable.realname^+'$'+realname+'$'+accessorname+'$'+pd.unique_id_str;
  344. finish_copied_procdef(pd,accessorname,obj.symtable,obj);
  345. sym:=pd.procsym;
  346. end;
  347. { add previously collected procoptions }
  348. pd.procoptions:=pd.procoptions+procoptions;
  349. { visibility }
  350. pd.visibility:=visibility;
  351. { new procsym? }
  352. if not assigned(sym) or
  353. (sym.owner<>owner) then
  354. begin
  355. ps:=cprocsym.create(accessorname);
  356. obj.symtable.insert(ps);
  357. end
  358. else
  359. ps:=tprocsym(sym);
  360. { associate procsym with procdef}
  361. pd.procsym:=ps;
  362. { function/procedure }
  363. accessorparapd:=nil;
  364. if getter then
  365. begin
  366. pd.proctypeoption:=potype_function;
  367. pd.synthetickind:=tsk_field_getter;
  368. { result type }
  369. pd.returndef:=propdef;
  370. if (ppo_hasparameters in propoptions) and
  371. not assigned(orgaccesspd) then
  372. accessorparapd:=pd;
  373. end
  374. else
  375. begin
  376. pd.proctypeoption:=potype_procedure;
  377. pd.synthetickind:=tsk_field_setter;
  378. pd.returndef:=voidtype;
  379. if not assigned(orgaccesspd) then
  380. begin
  381. { parameter with value to set }
  382. pvs:=cparavarsym.create('__fpc_newval__',10,vs_const,propdef,[]);
  383. pd.parast.insert(pvs);
  384. end;
  385. if (ppo_hasparameters in propoptions) and
  386. not assigned(orgaccesspd) then
  387. accessorparapd:=pd;
  388. end;
  389. { create a property for the old symaccesslist with a new accessorname, so that
  390. we can reuse it in the implementation (rather than having to
  391. translate the symaccesslist back to Pascal code) }
  392. callthroughpropname:='__fpc__'+realname;
  393. if getter then
  394. callthroughpropname:=callthroughpropname+'__getter_wrapper'
  395. else
  396. callthroughpropname:=callthroughpropname+'__setter_wrapper';
  397. callthroughprop:=cpropertysym.create(callthroughpropname);
  398. callthroughprop.visibility:=visibility;
  399. if getter then
  400. makeduplicate(callthroughprop,accessorparapd,nil,paranr)
  401. else
  402. makeduplicate(callthroughprop,nil,accessorparapd,paranr);
  403. callthroughprop.default:=longint($80000000);
  404. callthroughprop.default:=0;
  405. callthroughprop.propoptions:=callthroughprop.propoptions-[ppo_stored,ppo_enumerator_current,ppo_overrides,ppo_defaultproperty];
  406. if sp_static in symoptions then
  407. include(callthroughprop.symoptions, sp_static);
  408. { copy original property target to callthrough property (and replace
  409. original one with the new empty list; will be filled in later) }
  410. tmpaccesslist:=callthroughprop.propaccesslist[accesstyp];
  411. callthroughprop.propaccesslist[accesstyp]:=propaccesslist[accesstyp];
  412. propaccesslist[accesstyp]:=tmpaccesslist;
  413. owner.insert(callthroughprop);
  414. pd.skpara:=callthroughprop;
  415. { needs to be exported }
  416. include(pd.procoptions,po_global);
  417. { class property -> static class method }
  418. if sp_static in symoptions then
  419. pd.procoptions:=pd.procoptions+[po_classmethod,po_staticmethod];
  420. { in case we made a copy of the original accessor, this has all been
  421. done already }
  422. if not assigned(orgaccesspd) then
  423. begin
  424. { calling convention }
  425. handle_calling_convention(pd,hcc_default_actions_intf_struct);
  426. { register forward declaration with procsym }
  427. proc_add_definition(pd);
  428. end;
  429. { make the property call this new function }
  430. propaccesslist[accesstyp].addsym(sl_call,ps);
  431. propaccesslist[accesstyp].procdef:=pd;
  432. finally
  433. symtablestack.pop(obj.symtable);
  434. end;
  435. end;
  436. procedure tcpupropertysym.finalize_getter_or_setter_for_sym(getset: tpropaccesslisttypes; sym: tsym; fielddef: tdef; accessordef: tprocdef);
  437. var
  438. orgaccesspd: tprocdef;
  439. pprefix: pshortstring;
  440. wrongvisibility: boolean;
  441. begin
  442. inherited;
  443. if getset=palt_read then
  444. pprefix:=@prop_auto_getter_prefix
  445. else
  446. pprefix:=@prop_auto_setter_prefix;
  447. case sym.typ of
  448. procsym:
  449. begin
  450. orgaccesspd:=tprocdef(propaccesslist[getset].procdef);
  451. wrongvisibility:=tprocdef(propaccesslist[getset].procdef).visibility<visibility;
  452. { if the visibility of the accessor is lower than
  453. the visibility of the property, wrap it so that
  454. we can call it from all contexts in which the
  455. property is visible }
  456. if wrongvisibility or
  457. ((pprefix^<>'') and
  458. (sym.RealName<>pprefix^+RealName)) then
  459. create_getter_or_setter_for_property(orgaccesspd,getset=palt_read)
  460. end;
  461. fieldvarsym:
  462. begin
  463. { if the visibility of the field is lower than the
  464. visibility of the property, wrap it in a getter
  465. so that we can access it from all contexts in
  466. which the property is visibile }
  467. if (pprefix^<>'') or
  468. (tfieldvarsym(sym).visibility<visibility) then
  469. create_getter_or_setter_for_property(nil,getset=palt_read);
  470. end;
  471. else
  472. internalerror(2014061101);
  473. end;
  474. end;
  475. procedure tcpupropertysym.maybe_create_overridden_getter_or_setter(getset: tpropaccesslisttypes);
  476. var
  477. sym: tsym;
  478. accessordef: tprocdef;
  479. psym: tpropertysym;
  480. begin
  481. { find the last defined getter/setter/field accessed by an inherited
  482. property }
  483. psym:=overriddenpropsym;
  484. while not assigned(psym.propaccesslist[getset].firstsym) do
  485. begin
  486. psym:=psym.overriddenpropsym;
  487. { if there is simply no getter/setter for this property, we're done }
  488. if not assigned(psym) then
  489. exit;
  490. end;
  491. sym:=psym.propaccesslist[getset].firstsym^.sym;
  492. case sym.typ of
  493. procsym:
  494. begin
  495. accessordef:=tprocdef(psym.propaccesslist[getset].procdef);
  496. if accessordef.visibility>=visibility then
  497. exit;
  498. end;
  499. fieldvarsym:
  500. begin
  501. if sym.visibility>=visibility then
  502. exit;
  503. accessordef:=nil;
  504. end;
  505. else
  506. internalerror(2014061102);
  507. end;
  508. propaccesslist[getset]:=psym.propaccesslist[getset].getcopy;
  509. finalize_getter_or_setter_for_sym(getset,sym,propdef,accessordef);
  510. end;
  511. procedure tcpupropertysym.inherit_accessor(getset: tpropaccesslisttypes);
  512. begin
  513. inherited;
  514. { new property has higher visibility than previous one -> maybe override
  515. the getters/setters }
  516. if assigned(overriddenpropsym) and
  517. (overriddenpropsym.visibility<visibility) then
  518. maybe_create_overridden_getter_or_setter(getset);
  519. end;
  520. {****************************************************************************
  521. tcpuenumdef
  522. ****************************************************************************}
  523. procedure tcpuenumdef.ppuload_platform(ppufile: tcompilerppufile);
  524. begin
  525. inherited;
  526. ppufile.getderef(classdefderef);
  527. end;
  528. procedure tcpuenumdef.ppuwrite_platform(ppufile: tcompilerppufile);
  529. begin
  530. inherited;
  531. ppufile.putderef(classdefderef);
  532. end;
  533. function tcpuenumdef.getcopy: tstoreddef;
  534. begin
  535. result:=inherited;
  536. tcpuenumdef(result).classdef:=classdef;
  537. end;
  538. procedure tcpuenumdef.buildderef;
  539. begin
  540. inherited;
  541. classdefderef.build(classdef);
  542. end;
  543. procedure tcpuenumdef.deref;
  544. begin
  545. inherited;
  546. classdef:=tobjectdef(classdefderef.resolve);
  547. end;
  548. {****************************************************************************
  549. tcpuprocdef
  550. ****************************************************************************}
  551. function tcpuprocdef.getfuncretsyminfo(out ressym: tsym; out resdef: tdef): boolean;
  552. begin
  553. { constructors don't have a result on the JVM platform }
  554. if proctypeoption<>potype_constructor then
  555. result:=inherited
  556. else
  557. result:=false;
  558. end;
  559. destructor tcpuprocdef.destroy;
  560. begin
  561. exprasmlist.free;
  562. inherited destroy;
  563. end;
  564. {****************************************************************************
  565. tcpuprocvardef
  566. ****************************************************************************}
  567. procedure tcpuprocvardef.ppuwrite_platform(ppufile: tcompilerppufile);
  568. begin
  569. inherited;
  570. ppufile.putderef(classdefderef);
  571. end;
  572. procedure tcpuprocvardef.ppuload_platform(ppufile: tcompilerppufile);
  573. begin
  574. inherited;
  575. ppufile.getderef(classdefderef);
  576. end;
  577. procedure tcpuprocvardef.buildderef;
  578. begin
  579. inherited buildderef;
  580. classdefderef.build(classdef);
  581. end;
  582. procedure tcpuprocvardef.deref;
  583. begin
  584. inherited deref;
  585. classdef:=tobjectdef(classdefderef.resolve);
  586. end;
  587. function tcpuprocvardef.getcopy: tstoreddef;
  588. begin
  589. result:=inherited;
  590. tcpuprocvardef(result).classdef:=classdef;
  591. end;
  592. {****************************************************************************
  593. tcpuprocsym
  594. ****************************************************************************}
  595. procedure tcpuprocsym.check_forward;
  596. var
  597. curri, checki: longint;
  598. currpd, checkpd: tprocdef;
  599. begin
  600. inherited;
  601. { check for conflicts based on mangled name, because several FPC
  602. types/constructs map to the same JVM mangled name }
  603. for curri:=0 to FProcdefList.Count-2 do
  604. begin
  605. currpd:=tprocdef(FProcdefList[curri]);
  606. if (po_external in currpd.procoptions) or
  607. (currpd.proccalloption=pocall_internproc) then
  608. continue;
  609. for checki:=curri+1 to FProcdefList.Count-1 do
  610. begin
  611. checkpd:=tprocdef(FProcdefList[checki]);
  612. if po_external in checkpd.procoptions then
  613. continue;
  614. if currpd.mangledname=checkpd.mangledname then
  615. begin
  616. MessagePos(checkpd.fileinfo,parser_e_overloaded_have_same_mangled_name);
  617. MessagePos1(currpd.fileinfo,sym_e_param_list,currpd.customprocname([pno_mangledname]));
  618. MessagePos1(checkpd.fileinfo,sym_e_param_list,checkpd.customprocname([pno_mangledname]));
  619. end;
  620. end;
  621. end;
  622. inherited;
  623. end;
  624. {****************************************************************************
  625. tcpustaticvarsym
  626. ****************************************************************************}
  627. {****************************************************************************
  628. tcpufieldvarsym
  629. ****************************************************************************}
  630. initialization
  631. { used tdef classes }
  632. cfiledef:=tcpufiledef;
  633. cvariantdef:=tcpuvariantdef;
  634. cformaldef:=tcpuformaldef;
  635. cforwarddef:=tcpuforwarddef;
  636. cundefineddef:=tcpuundefineddef;
  637. cerrordef:=tcpuerrordef;
  638. cpointerdef:=tcpupointerdef;
  639. crecorddef:=tcpurecorddef;
  640. cimplementedinterface:=tcpuimplementedinterface;
  641. cobjectdef:=tcpuobjectdef;
  642. cclassrefdef:=tcpuclassrefdef;
  643. carraydef:=tcpuarraydef;
  644. corddef:=tcpuorddef;
  645. cfloatdef:=tcpufloatdef;
  646. cprocvardef:=tcpuprocvardef;
  647. cprocdef:=tcpuprocdef;
  648. cstringdef:=tcpustringdef;
  649. cenumdef:=tcpuenumdef;
  650. csetdef:=tcpusetdef;
  651. { used tsym classes }
  652. clabelsym:=tcpulabelsym;
  653. cunitsym:=tcpuunitsym;
  654. cprogramparasym:=tcpuprogramparasym;
  655. cnamespacesym:=tcpunamespacesym;
  656. cprocsym:=tcpuprocsym;
  657. ctypesym:=tcputypesym;
  658. cfieldvarsym:=tcpufieldvarsym;
  659. clocalvarsym:=tcpulocalvarsym;
  660. cparavarsym:=tcpuparavarsym;
  661. cstaticvarsym:=tcpustaticvarsym;
  662. cabsolutevarsym:=tcpuabsolutevarsym;
  663. cpropertysym:=tcpupropertysym;
  664. cconstsym:=tcpuconstsym;
  665. cenumsym:=tcpuenumsym;
  666. csyssym:=tcpusyssym;
  667. end.