procdefutil.pas 57 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618
  1. {
  2. Copyright (c) 2018 by Jonas Maebe
  3. Copyright (c) 2011-2021 by Blaise.ru
  4. This unit provides helpers for creating procdefs
  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 procdefutil;
  20. interface
  21. uses
  22. globtype,procinfo,
  23. symconst,symtype,symdef,
  24. node,nbas;
  25. { create a nested procdef that will be used to outline code from a procedure;
  26. astruct should usually be nil, except in special cases like the Windows SEH
  27. exception handling funclets }
  28. function create_outline_procdef(const basesymname: string; astruct: tabstractrecorddef; potype: tproctypeoption; resultdef: tdef): tprocdef;
  29. procedure convert_to_funcref_intf(const n:tidstring;var def:tdef);
  30. function adjust_funcref(var def:tdef;sym,dummysym:tsym):boolean;
  31. { functionality related to capturing local variables for anonymous functions }
  32. function get_or_create_capturer(pd:tprocdef):tsym;
  33. function capturer_add_anonymous_proc(owner:tprocinfo;pd:tprocdef;out capturer:tsym):tobjectdef;
  34. function capturer_add_procvar_or_proc(owner:tprocinfo;n:tnode;out capturer:tsym;out capturen:tnode):tobjectdef;
  35. procedure initialize_capturer(ctx:tprocinfo;var stmt:tstatementnode);
  36. procedure postprocess_capturer(ctx:tprocinfo);
  37. procedure convert_captured_syms(pd:tprocdef;tree:tnode);
  38. implementation
  39. uses
  40. cutils,cclasses,verbose,globals,
  41. fmodule,
  42. pass_1,
  43. nobj,ncal,nmem,nld,nutils,
  44. ngenutil,
  45. symbase,symsym,symtable,defutil,defcmp,
  46. htypechk,
  47. pparautl,psub;
  48. function create_outline_procdef(const basesymname: string; astruct: tabstractrecorddef; potype: tproctypeoption; resultdef: tdef): tprocdef;
  49. var
  50. st:TSymTable;
  51. checkstack: psymtablestackitem;
  52. oldsymtablestack: tsymtablestack;
  53. sym:tprocsym;
  54. begin
  55. { get actual procedure symtable (skip withsymtables, etc.) }
  56. st:=nil;
  57. checkstack:=symtablestack.stack;
  58. while assigned(checkstack) do
  59. begin
  60. st:=checkstack^.symtable;
  61. if st.symtabletype in [staticsymtable,globalsymtable,localsymtable] then
  62. break;
  63. checkstack:=checkstack^.next;
  64. end;
  65. { Create a nested procedure, even from main_program_level.
  66. Furthermore, force procdef and procsym into the same symtable
  67. (by default, defs are registered with symtablestack.top which may be
  68. something temporary like exceptsymtable - in that case, procdef can be
  69. destroyed before procsym, leaving invalid pointers). }
  70. oldsymtablestack:=symtablestack;
  71. symtablestack:=nil;
  72. result:=cprocdef.create(max(normal_function_level,st.symtablelevel)+1,true);
  73. result.returndef:=resultdef;
  74. { if the parent is a generic or a specialization, the new function is one
  75. as well }
  76. if st.symtabletype=localsymtable then
  77. result.defoptions:=result.defoptions+(tstoreddef(st.defowner).defoptions*[df_generic,df_specialization]);
  78. symtablestack:=oldsymtablestack;
  79. st.insertdef(result);
  80. result.struct:=astruct;
  81. { tabstractprocdef constructor sets po_delphi_nested_cc whenever
  82. nested procvars modeswitch is active. We must be independent of this switch. }
  83. exclude(result.procoptions,po_delphi_nested_cc);
  84. result.proctypeoption:=potype;
  85. { always use the default calling convention }
  86. result.proccalloption:=pocall_default;
  87. include(result.procoptions,po_hascallingconvention);
  88. handle_calling_convention(result,hcc_default_actions_impl);
  89. sym:=cprocsym.create(basesymname+result.unique_id_str);
  90. st.insertsym(sym);
  91. result.procsym:=sym;
  92. proc_add_definition(result);
  93. { the code will be assigned directly to the "code" field later }
  94. result.forwarddef:=false;
  95. result.aliasnames.insert(result.mangledname);
  96. end;
  97. function fileinfo_to_suffix(const fileinfo:tfileposinfo):tsymstr;inline;
  98. begin
  99. result:=tostr(fileinfo.moduleindex)+'_'+
  100. tostr(fileinfo.fileindex)+'_'+
  101. tostr(fileinfo.line)+'_'+
  102. tostr(fileinfo.column);
  103. end;
  104. const
  105. anon_funcref_prefix='$FuncRef_';
  106. capturer_class_name='$CapturerClass';
  107. { the leading $ is only added when registering the var symbol }
  108. capturer_var_name='Capturer';
  109. keepalive_suffix='_keepalive';
  110. outer_self_field_name='OuterSelf';
  111. procedure convert_to_funcref_intf(const n:tidstring;var def:tdef);
  112. var
  113. oldsymtablestack : tsymtablestack;
  114. pvdef : tprocvardef absolute def;
  115. intfdef : tobjectdef;
  116. invokedef : tprocdef;
  117. psym : tprocsym;
  118. sym : tsym;
  119. st : tsymtable;
  120. i : longint;
  121. name : tidstring;
  122. begin
  123. if def.typ<>procvardef then
  124. internalerror(2021040201);
  125. if not (po_is_function_ref in tprocvardef(pvdef).procoptions) then
  126. internalerror(2021022101);
  127. if n='' then
  128. name:=anon_funcref_prefix+fileinfo_to_suffix(current_filepos)
  129. else
  130. name:=n;
  131. intfdef:=cobjectdef.create(odt_interfacecom,name,interface_iunknown,true);
  132. include(intfdef.objectoptions,oo_is_funcref);
  133. include(intfdef.objectoptions,oo_is_invokable);
  134. include(intfdef.objectoptions,oo_has_virtual);
  135. intfdef.typesym:=pvdef.typesym;
  136. pvdef.typesym:=nil;
  137. intfdef.defoptions:=intfdef.defoptions+pvdef.defoptions*[df_generic,df_specialization];
  138. { also inherit the general flags from the surrounding structured type or
  139. function }
  140. if assigned(current_structdef) then
  141. begin
  142. intfdef.defoptions:=intfdef.defoptions+current_structdef.defoptions*[df_generic,df_specialization];
  143. end
  144. else if assigned(current_procinfo) then
  145. begin
  146. intfdef.defoptions:=intfdef.defoptions+current_procinfo.procdef.defoptions*[df_generic,df_specialization];
  147. end;
  148. if cs_generate_rtti in current_settings.localswitches then
  149. include(intfdef.objectoptions,oo_can_have_published);
  150. oldsymtablestack:=symtablestack;
  151. symtablestack:=nil;
  152. invokedef:=tprocdef(pvdef.getcopyas(procdef,pc_normal_no_paras,'',false));
  153. invokedef.struct:=intfdef;
  154. invokedef.forwarddef:=false;
  155. include(invokedef.procoptions,po_overload);
  156. include(invokedef.procoptions,po_virtualmethod);
  157. invokedef.procsym:=cprocsym.create(method_name_funcref_invoke_decl);
  158. if cs_generate_rtti in current_settings.localswitches then
  159. invokedef.visibility:=vis_published
  160. else
  161. invokedef.visibility:=vis_public;
  162. intfdef.symtable.insertsym(invokedef.procsym);
  163. intfdef.symtable.insertdef(invokedef);
  164. { we need to do this even if the def isn't a generic/specialization itself,
  165. but *belongs* to one }
  166. if intfdef.defoptions*[df_generic,df_specialization]<>[] then
  167. begin
  168. if assigned(pvdef.genericdef) and (pvdef.genericdef.typ<>objectdef) then
  169. internalerror(2021040501);
  170. intfdef.genericdef:=pvdef.genericdef;
  171. { in case of a generic we move all involved syms/defs to the interface }
  172. intfdef.genericparas:=pvdef.genericparas;
  173. pvdef.genericparas:=nil;
  174. if assigned(intfdef.genericparas) then
  175. for i:=0 to intfdef.genericparas.count-1 do
  176. begin
  177. sym:=tsym(intfdef.genericparas[i]);
  178. if sym.owner<>pvdef.parast then
  179. continue;
  180. sym.changeowner(intfdef.symtable);
  181. if (sym.typ=typesym) and (ttypesym(sym).typedef.owner=pvdef.parast) then
  182. ttypesym(sym).typedef.changeowner(intfdef.symtable);
  183. end;
  184. end;
  185. { now move the symtable over }
  186. invokedef.parast.free;
  187. invokedef.parast:=pvdef.parast;
  188. invokedef.parast.defowner:=invokedef;
  189. pvdef.parast:=nil;
  190. for i:=0 to invokedef.parast.symlist.count-1 do
  191. begin
  192. sym:=tsym(invokedef.parast.symlist[i]);
  193. if sym.typ<>paravarsym then
  194. continue;
  195. if tparavarsym(sym).vardef=pvdef then
  196. tparavarsym(sym).vardef:=intfdef;
  197. end;
  198. symtablestack:=oldsymtablestack;
  199. if invokedef.returndef=pvdef then
  200. invokedef.returndef:=intfdef;
  201. handle_calling_convention(invokedef,hcc_default_actions_intf_struct);
  202. proc_add_definition(invokedef);
  203. invokedef.calcparas;
  204. { def is not owned, so it can be simply freed }
  205. def.free;
  206. def:=intfdef;
  207. end;
  208. function adjust_funcref(var def:tdef;sym,dummysym:tsym):boolean;
  209. var
  210. sympos : tfileposinfo;
  211. name : string;
  212. begin
  213. result:=false;
  214. if (def.typ<>procvardef) and not is_funcref(def) then
  215. internalerror(2022020401);
  216. if assigned(sym) and not (sym.typ=typesym) then
  217. internalerror(2022020402);
  218. { these always support everything, no "of object" or
  219. "is_nested" is allowed }
  220. if is_nested_pd(tprocvardef(def)) or
  221. is_methodpointer(def) then
  222. cgmessage(type_e_function_reference_kind);
  223. if not (po_is_block in tprocvardef(def).procoptions) then
  224. begin
  225. if assigned(dummysym) then
  226. ttypesym(dummysym).typedef:=nil;
  227. if assigned(sym) then
  228. begin
  229. ttypesym(sym).typedef:=nil;
  230. name:=sym.name;
  231. end
  232. else
  233. name:='';
  234. convert_to_funcref_intf(name,def);
  235. if assigned(sym) then
  236. ttypesym(sym).typedef:=def;
  237. if assigned(dummysym) then
  238. ttypesym(dummysym).typedef:=def;
  239. build_vmt(tobjectdef(def));
  240. result:=true;
  241. end
  242. else
  243. begin
  244. if assigned(sym) and (sym.refs>0) then
  245. begin
  246. { find where the symbol was used and trigger
  247. a "symbol not completely defined" error }
  248. if not fileinfo_of_typesym_in_def(def,sym,sympos) then
  249. sympos:=sym.fileinfo;
  250. messagepos1(sympos,type_e_type_is_not_completly_defined,sym.realname);
  251. end;
  252. end;
  253. end;
  254. function funcref_intf_for_proc(pd:tabstractprocdef;const suffix:string):tobjectdef;
  255. var
  256. name : tsymstr;
  257. sym : tsym;
  258. symowner : tsymtable;
  259. oldsymtablestack: TSymtablestack;
  260. invokedef: tprocdef;
  261. begin
  262. if pd.is_generic then
  263. internalerror(2022010710);
  264. name:='funcrefintf_'+suffix;
  265. if pd.owner.symtabletype=globalsymtable then
  266. symowner:=current_module.localsymtable
  267. else
  268. symowner:=pd.owner;
  269. sym:=tsym(symowner.find(name));
  270. if assigned(sym) then
  271. begin
  272. if sym.typ<>typesym then
  273. internalerror(2022010708);
  274. if not is_funcref(ttypesym(sym).typedef) then
  275. internalerror(2022010709);
  276. result:=tobjectdef(ttypesym(sym).typedef);
  277. exit;
  278. end;
  279. name:='$'+name;
  280. result:=cobjectdef.create(odt_interfacecom,name,interface_iunknown,false);
  281. include(result.objectoptions,oo_is_funcref);
  282. include(result.objectoptions,oo_is_invokable);
  283. sym:=ctypesym.create(name,result);
  284. oldsymtablestack:=symtablestack;
  285. symtablestack:=nil;
  286. invokedef:=tprocdef(pd.getcopyas(procdef,pc_normal_no_hidden,'',false));
  287. invokedef.struct:=result;
  288. invokedef.visibility:=vis_public;
  289. invokedef.procsym:=cprocsym.create(method_name_funcref_invoke_decl);
  290. invokedef.parast.symtablelevel:=normal_function_level;
  291. invokedef.localst.symtablelevel:=normal_function_level;
  292. include(invokedef.procoptions,po_virtualmethod);
  293. exclude(invokedef.procoptions,po_staticmethod);
  294. exclude(invokedef.procoptions,po_classmethod);
  295. invokedef.forwarddef:=false;
  296. symtablestack:=oldsymtablestack;
  297. result.symtable.insertsym(invokedef.procsym);
  298. result.symtable.insertdef(invokedef);
  299. proc_add_definition(invokedef);
  300. invokedef.calcparas;
  301. include(result.objectoptions,oo_has_virtual);
  302. symowner.insertsym(sym);
  303. symowner.insertdef(result);
  304. addsymref(sym);
  305. build_vmt(result);
  306. end;
  307. {.$define DEBUG_CAPTURER}
  308. function get_capturer(pd:tprocdef):tabstractvarsym;
  309. function getsym(st:tsymtable;typ:tsymtyp):tabstractvarsym;
  310. begin
  311. result:=tabstractvarsym(st.find(capturer_var_name));
  312. if not assigned(result) then
  313. internalerror(2022010703);
  314. if result.typ<>typ then
  315. internalerror(2022010704);
  316. if not is_class(result.vardef) then
  317. internalerror(2022010705);
  318. end;
  319. begin
  320. case pd.proctypeoption of
  321. potype_unitfinalize,
  322. potype_unitinit,
  323. potype_proginit:
  324. begin
  325. if not assigned(pd.owner) then
  326. internalerror(2022052401);
  327. if pd.owner.symtabletype<>staticsymtable then
  328. internalerror(2022052402);
  329. result:=getsym(pd.owner,staticvarsym);
  330. end;
  331. else
  332. begin
  333. if not assigned(pd.localst) then
  334. internalerror(2022020502);
  335. result:=getsym(pd.localst,localvarsym);
  336. end;
  337. end;
  338. end;
  339. function get_capturer_alive(pd:tprocdef):tabstractvarsym;
  340. function getsym(st:tsymtable;typ:tsymtyp):tabstractvarsym;
  341. begin
  342. result:=tabstractvarsym(st.find(capturer_var_name+keepalive_suffix));
  343. if not assigned(result) then
  344. internalerror(2022051703);
  345. if result.typ<>typ then
  346. internalerror(2022051704);
  347. if not is_interfacecom(result.vardef) then
  348. internalerror(2022051705);
  349. end;
  350. begin
  351. case pd.proctypeoption of
  352. potype_unitfinalize,
  353. potype_unitinit,
  354. potype_proginit:
  355. begin
  356. if not assigned(pd.owner) then
  357. internalerror(2022052403);
  358. if pd.owner.symtabletype<>staticsymtable then
  359. internalerror(2022052404);
  360. result:=getsym(pd.owner,staticvarsym);
  361. end;
  362. else
  363. begin
  364. if not assigned(pd.localst) then
  365. internalerror(2022051702);
  366. result:=getsym(pd.localst,localvarsym);
  367. end;
  368. end;
  369. end;
  370. function get_or_create_capturer(pd:tprocdef):tsym;
  371. var
  372. name : tsymstr;
  373. parent,
  374. def : tobjectdef;
  375. typesym : tsym;
  376. keepalive : tabstractvarsym;
  377. intfimpl : TImplementedInterface;
  378. st : tsymtable;
  379. begin
  380. if pd.has_capturer then
  381. begin
  382. result:=get_capturer(pd);
  383. end
  384. else
  385. begin
  386. parent:=tobjectdef(search_system_type('TINTERFACEDOBJECT').typedef);
  387. if not is_class(parent) then
  388. internalerror(2022010706);
  389. name:=capturer_class_name+'_'+fileinfo_to_suffix(pd.fileinfo);
  390. case pd.proctypeoption of
  391. potype_unitfinalize,
  392. potype_unitinit,
  393. potype_proginit:
  394. st:=pd.owner;
  395. else
  396. st:=pd.localst;
  397. end;
  398. def:=cobjectdef.create(odt_class,name,parent,false);
  399. typesym:=ctypesym.create(name,def);
  400. typesym.fileinfo:=pd.fileinfo;
  401. st.insertdef(def);
  402. st.insertsym(typesym);
  403. addsymref(typesym);
  404. if df_generic in pd.defoptions then
  405. include(def.defoptions,df_generic);
  406. { don't set df_specialization as in that case genericdef needs to be
  407. set, but the local symtables are freed once a unit is finished }
  408. {if df_specialization in pd.defoptions then
  409. begin
  410. if not assigned(pd.genericdef) or (pd.genericdef.typ<>procdef) then
  411. internalerror(2022020501);
  412. def.genericdef:=tstoreddef(get_capturer(tprocdef(pd.genericdef)).vardef);
  413. include(def.defoptions,df_specialization);
  414. end;}
  415. if st.symtabletype=localsymtable then
  416. result:=clocalvarsym.create('$'+capturer_var_name,vs_value,def,[vo_is_internal])
  417. else
  418. result:=cstaticvarsym.create('$'+capturer_var_name,vs_value,def,[vo_is_internal]);
  419. result.fileinfo:=pd.fileinfo;
  420. st.insertsym(result);
  421. addsymref(result);
  422. if st.symtabletype=localsymtable then
  423. keepalive:=clocalvarsym.create('$'+capturer_var_name+keepalive_suffix,vs_value,interface_iunknown,[vo_is_internal])
  424. else
  425. keepalive:=cstaticvarsym.create('$'+capturer_var_name+keepalive_suffix,vs_value,interface_iunknown,[vo_is_internal]);
  426. keepalive.fileinfo:=pd.fileinfo;
  427. st.insertsym(keepalive);
  428. addsymref(keepalive);
  429. if st.symtabletype<>localsymtable then
  430. begin
  431. cnodeutils.insertbssdata(tstaticvarsym(result));
  432. cnodeutils.insertbssdata(tstaticvarsym(keepalive));
  433. end;
  434. { avoid warnings as these symbols are initialized using initialize_capturer
  435. after parsing the body }
  436. tabstractvarsym(result).varstate:=vs_readwritten;
  437. keepalive.varstate:=vs_readwritten;
  438. pd.has_capturer:=true;
  439. end;
  440. end;
  441. function can_be_captured(sym:tsym):boolean;
  442. begin
  443. result:=false;
  444. if not (sym.typ in [localvarsym,paravarsym]) then
  445. exit;
  446. if tabstractnormalvarsym(sym).varoptions*[vo_is_result,vo_is_funcret]<>[] then
  447. exit;
  448. if sym.typ=paravarsym then
  449. begin
  450. if (tparavarsym(sym).varspez in [vs_out,vs_var]) and
  451. not (vo_is_self in tparavarsym(sym).varoptions) then
  452. exit;
  453. if is_open_array(tparavarsym(sym).vardef) then
  454. exit;
  455. end;
  456. result:=true;
  457. end;
  458. type
  459. tsym_mapping = record
  460. oldsym:tsym;
  461. newsym:tsym;
  462. end;
  463. psym_mapping = ^tsym_mapping;
  464. function replace_self_sym(var n:tnode;arg:pointer):foreachnoderesult;
  465. var
  466. mapping : psym_mapping absolute arg;
  467. ld : tloadnode;
  468. begin
  469. if n.nodetype=loadn then
  470. begin
  471. ld:=tloadnode(n);
  472. if ld.symtableentry=mapping^.oldsym then
  473. begin
  474. ld.symtableentry:=mapping^.newsym;
  475. { make sure that the node is processed again }
  476. ld.resultdef:=nil;
  477. if assigned(ld.left) then
  478. begin
  479. { no longer loaded through the frame pointer }
  480. ld.left.free;
  481. ld.left:=nil;
  482. end;
  483. typecheckpass(n);
  484. end;
  485. end;
  486. result:=fen_true;
  487. end;
  488. procedure capture_captured_syms(pd:tprocdef;owner:tprocinfo;capturedef:tobjectdef);
  489. var
  490. curpd : tprocdef;
  491. subcapturer : tobjectdef;
  492. symstodo : TFPList;
  493. i : longint;
  494. sym : tsym;
  495. fieldsym : tfieldvarsym;
  496. fieldname : tsymstr;
  497. begin
  498. if not pd.was_anonymous or not assigned(pd.capturedsyms) or (pd.capturedsyms.count=0) then
  499. exit;
  500. { capture all variables that the original procdef captured }
  501. curpd:=owner.procdef;
  502. subcapturer:=capturedef;
  503. symstodo:=tfplist.create;
  504. for i:=0 to pd.capturedsyms.count-1 do
  505. if can_be_captured(pcapturedsyminfo(pd.capturedsyms[i])^.sym) then
  506. symstodo.add(pcapturedsyminfo(pd.capturedsyms[i])^.sym);
  507. while symstodo.count>0 do
  508. begin
  509. { we know we have symbols left to capture thus we either have a
  510. symbol that's located in the capturer of the current procdef or
  511. we need to put in the OuterSelf reference }
  512. if curpd=owner.procdef then
  513. subcapturer:=capturedef
  514. else
  515. subcapturer:=tobjectdef(tabstractvarsym(get_or_create_capturer(curpd)).vardef);
  516. i:=0;
  517. while i<symstodo.count do
  518. begin
  519. sym:=tsym(symstodo[i]);
  520. if (sym.owner=curpd.localst) or
  521. (sym.owner=curpd.parast) then
  522. begin
  523. {$ifdef DEBUG_CAPTURER}writeln('Symbol ',sym.name,' captured from ',curpd.procsym.name);{$endif}
  524. { the symbol belongs to the current procdef, so add a field to
  525. the capturer if it doesn't already exist }
  526. if vo_is_self in tabstractnormalvarsym(sym).varoptions then
  527. fieldname:=outer_self_field_name
  528. else
  529. fieldname:=sym.name;
  530. fieldsym:=tfieldvarsym(subcapturer.symtable.find(fieldname));
  531. if not assigned(fieldsym) then
  532. begin
  533. {$ifdef DEBUG_CAPTURER}writeln('Adding field ',fieldname,' to ',subcapturer.typesym.name);{$endif}
  534. if vo_is_self in tabstractnormalvarsym(sym).varoptions then
  535. fieldname:='$'+fieldname;
  536. fieldsym:=cfieldvarsym.create(fieldname,vs_value,tabstractvarsym(sym).vardef,[]);
  537. fieldsym.fileinfo:=sym.fileinfo;
  538. subcapturer.symtable.insertsym(fieldsym);
  539. tabstractrecordsymtable(subcapturer.symtable).addfield(fieldsym,vis_public);
  540. end;
  541. if not assigned(tabstractnormalvarsym(sym).capture_sym) then
  542. tabstractnormalvarsym(sym).capture_sym:=fieldsym
  543. else if tabstractnormalvarsym(sym).capture_sym<>fieldsym then
  544. internalerror(2022011602);
  545. symstodo.delete(i);
  546. end
  547. else
  548. inc(i);
  549. end;
  550. if symstodo.count>0 then
  551. begin
  552. if curpd.owner.symtabletype<>localsymtable then
  553. internalerror(2022011001);
  554. { there are still symbols left, so before we move to the parent
  555. procdef we add the OuterSelf field to set up the chain of
  556. capturers }
  557. {$ifdef DEBUG_CAPTURER}writeln('Initialize capturer for ',curpd.procsym.name);{$endif}
  558. { we no longer need the curpd, but we need the parent, so change
  559. curpd here }
  560. curpd:=tprocdef(curpd.owner.defowner);
  561. if curpd.typ<>procdef then
  562. internalerror(2022011002);
  563. if not assigned(subcapturer.symtable.find(outer_self_field_name)) then
  564. begin
  565. {$ifdef DEBUG_CAPTURER}writeln('Adding field OuterSelf to ',subcapturer.typesym.name);{$endif}
  566. if subcapturer.owner.symtablelevel>normal_function_level then
  567. { the outer self is the capturer of the outer procdef }
  568. sym:=get_or_create_capturer(curpd)
  569. else
  570. begin
  571. { the outer self is the self of the method }
  572. if not (curpd.owner.symtabletype in [objectsymtable,recordsymtable]) then
  573. internalerror(2022011603);
  574. sym:=tsym(curpd.parast.find('self'));
  575. if not assigned(sym) then
  576. internalerror(2022011604);
  577. end;
  578. { add the keep alive IUnknown symbol }
  579. fieldsym:=cfieldvarsym.create('$'+outer_self_field_name+keepalive_suffix,vs_value,interface_iunknown,[]);
  580. fieldsym.fileinfo:=sym.fileinfo;
  581. subcapturer.symtable.insertsym(fieldsym);
  582. tabstractrecordsymtable(subcapturer.symtable).addfield(fieldsym,vis_public);
  583. { add the capturer symbol }
  584. fieldsym:=cfieldvarsym.create('$'+outer_self_field_name,vs_value,tabstractvarsym(sym).vardef,[]);
  585. fieldsym.fileinfo:=sym.fileinfo;
  586. subcapturer.symtable.insertsym(fieldsym);
  587. tabstractrecordsymtable(subcapturer.symtable).addfield(fieldsym,vis_public);
  588. if (sym.typ=paravarsym) and (vo_is_self in tparavarsym(sym).varoptions) then
  589. begin
  590. if assigned(tparavarsym(sym).capture_sym) then
  591. internalerror(2022011705);
  592. tparavarsym(sym).capture_sym:=fieldsym;
  593. end;
  594. end;
  595. end;
  596. end;
  597. symstodo.free;
  598. end;
  599. function retrieve_sym_for_filepos(var n:tnode;arg:pointer):foreachnoderesult;
  600. var
  601. sym : ^tsym absolute arg;
  602. begin
  603. if assigned(sym^) then
  604. exit(fen_norecurse_true);
  605. result:=fen_false;
  606. if not (n.resultdef.typ in [procdef,procvardef]) then
  607. exit;
  608. if n.nodetype=loadn then
  609. begin
  610. sym^:=tloadnode(n).symtableentry;
  611. result:=fen_norecurse_true;
  612. end
  613. else if n.nodetype=subscriptn then
  614. begin
  615. sym^:=tsubscriptnode(n).vs;
  616. result:=fen_norecurse_true;
  617. end;
  618. end;
  619. function collect_syms_to_capture(var n:tnode;arg:pointer):foreachnoderesult;
  620. var
  621. pd : tprocdef absolute arg;
  622. sym : tsym;
  623. begin
  624. result:=fen_false;
  625. if n.nodetype<>loadn then
  626. exit;
  627. sym:=tsym(tloadnode(n).symtableentry);
  628. if not (sym.owner.symtabletype in [parasymtable,localsymtable]) then
  629. exit;
  630. if sym.owner.symtablelevel>normal_function_level then begin
  631. pd.add_captured_sym(sym,n.fileinfo);
  632. result:=fen_true;
  633. end;
  634. end;
  635. type
  636. tselfinfo=record
  637. selfsym:tsym;
  638. ignore:tsym;
  639. end;
  640. pselfinfo=^tselfinfo;
  641. function find_self_sym(var n:tnode;arg:pointer):foreachnoderesult;
  642. var
  643. info : pselfinfo absolute arg;
  644. begin
  645. result:=fen_false;
  646. if assigned(info^.selfsym) then
  647. exit(fen_norecurse_true);
  648. if n.nodetype<>loadn then
  649. exit;
  650. if tloadnode(n).symtableentry.typ<>paravarsym then
  651. exit;
  652. if tloadnode(n).symtableentry=info^.ignore then
  653. exit;
  654. if vo_is_self in tparavarsym(tloadnode(n).symtableentry).varoptions then
  655. begin
  656. info^.selfsym:=tparavarsym(tloadnode(n).symtableentry);
  657. result:=fen_norecurse_true;
  658. end;
  659. end;
  660. function find_outermost_loaded_sym(var n:tnode;arg:pointer):foreachnoderesult;
  661. var
  662. sym : ^tsym absolute arg;
  663. begin
  664. if assigned(sym^) then
  665. exit(fen_norecurse_true);
  666. result:=fen_false;
  667. if n.nodetype<>loadn then
  668. exit;
  669. sym^:=tloadnode(n).symtableentry;
  670. result:=fen_norecurse_true;
  671. end;
  672. function find_procdef(var n:tnode;arg:pointer):foreachnoderesult;
  673. var
  674. pd : ^tprocdef absolute arg;
  675. begin
  676. if assigned(pd^) then
  677. exit(fen_norecurse_true);
  678. result:=fen_false;
  679. if n.resultdef.typ<>procdef then
  680. exit;
  681. pd^:=tprocdef(n.resultdef);
  682. result:=fen_norecurse_true;
  683. end;
  684. function capturer_add_procvar_or_proc(owner:tprocinfo;n:tnode;out capturer:tsym;out capturen:tnode):tobjectdef;
  685. function create_paras(pd:tprocdef):tcallparanode;
  686. var
  687. para : tparavarsym;
  688. i : longint;
  689. begin
  690. result:=nil;
  691. for i:=0 to pd.paras.count-1 do
  692. begin
  693. para:=tparavarsym(pd.paras[i]);
  694. if vo_is_hidden_para in para.varoptions then
  695. continue;
  696. result:=ccallparanode.create(cloadnode.create(para,pd.parast),result);
  697. end;
  698. end;
  699. function find_nested_procinfo(pd:tprocdef):tcgprocinfo;
  700. var
  701. tmp,
  702. res : tprocinfo;
  703. begin
  704. tmp:=owner;
  705. while assigned(tmp) and (tmp.procdef.parast.symtablelevel>=normal_function_level) do
  706. begin
  707. res:=tmp.find_nestedproc_by_pd(pd);
  708. if assigned(res) then
  709. exit(tcgprocinfo(res));
  710. tmp:=tmp.parent;
  711. end;
  712. result:=nil;
  713. end;
  714. procedure swap_symtable(var st1,st2:tsymtable);
  715. var
  716. st : tsymtable;
  717. owner : tdefentry;
  718. level : byte;
  719. begin
  720. { first swap the symtables themselves }
  721. st:=st1;
  722. st1:=st2;
  723. st2:=st;
  724. { then swap the symtables' owners }
  725. owner:=st1.defowner;
  726. st1.defowner:=st2.defowner;
  727. st2.defowner:=owner;
  728. { and finally the symtable level }
  729. level:=st1.symtablelevel;
  730. st1.symtablelevel:=st2.symtablelevel;
  731. st2.symtablelevel:=level;
  732. end;
  733. procedure print_procinfo(pi:tcgprocinfo);
  734. begin
  735. { Print the node to tree.log }
  736. if paraprintnodetree <> 0 then
  737. pi.printproc('after parsing');
  738. {$ifdef DEBUG_NODE_XML}
  739. { Methods of generic classes don't get any code generated, so output
  740. the node tree here }
  741. if (df_generic in pi.procdef.defoptions) then
  742. pi.XMLPrintProc(True);
  743. {$endif DEBUG_NODE_XML}
  744. end;
  745. var
  746. ps : tprocsym;
  747. pd : tprocdef;
  748. pinested,
  749. pi : tcgprocinfo;
  750. sym,
  751. fpsym,
  752. selfsym : tsym;
  753. invokename : tsymstr;
  754. capturedef : tobjectdef;
  755. capturesyms : tfplist;
  756. captured : pcapturedsyminfo;
  757. implintf : TImplementedInterface;
  758. i : longint;
  759. stmt : tstatementnode;
  760. n1 : tnode;
  761. fieldsym : tfieldvarsym;
  762. selfinfo : tselfinfo;
  763. begin
  764. if not (n.resultdef.typ in [procdef,procvardef]) then
  765. internalerror(2022022101);
  766. capturer:=nil;
  767. capturen:=nil;
  768. pinested:=nil;
  769. { determine a unique name for the variable, field for function of the
  770. node we're trying to load }
  771. sym:=nil;
  772. if not foreachnodestatic(pm_preprocess,n,@find_outermost_loaded_sym,@sym) then
  773. internalerror(2022022102);
  774. result:=funcref_intf_for_proc(tabstractprocdef(n.resultdef),fileinfo_to_suffix(sym.fileinfo));
  775. if (sym.typ=procsym) and (sym.owner.symtabletype=localsymtable) then
  776. begin
  777. { this is assigning a nested function, so retrieve the correct procdef
  778. so that we can then retrieve the procinfo for it }
  779. if n.resultdef.typ=procdef then
  780. pd:=tprocdef(n.resultdef)
  781. else
  782. begin
  783. pd:=nil;
  784. if not foreachnodestatic(pm_preprocess,n,@find_procdef,@pd) then
  785. internalerror(2022041801);
  786. if not assigned(pd) then
  787. internalerror(2022041802);
  788. end;
  789. { check whether all captured symbols can indeed be captured }
  790. capturesyms:=pd.capturedsyms;
  791. if assigned(capturesyms) then
  792. for i:=0 to capturesyms.count-1 do
  793. begin
  794. captured:=pcapturedsyminfo(capturesyms[i]);
  795. if not can_be_captured(captured^.sym) then
  796. MessagePos1(captured^.fileinfo,sym_e_symbol_no_capture,captured^.sym.realname);
  797. end;
  798. if not (df_generic in owner.procdef.defoptions) then
  799. begin
  800. pinested:=find_nested_procinfo(pd);
  801. if not assigned(pinested) then
  802. internalerror(2022041803);
  803. if pinested.parent<>owner then
  804. begin
  805. { we need to capture this into the owner of the nested function
  806. instead }
  807. owner:=pinested;
  808. capturer:=get_or_create_capturer(pinested.procdef);
  809. if not assigned(capturer) then
  810. internalerror(2022041804);
  811. end;
  812. end;
  813. end
  814. else if (n.resultdef.typ=procvardef) and
  815. (po_delphi_nested_cc in tprocvardef(n.resultdef).procoptions) then
  816. begin
  817. MessagePos(n.fileinfo,type_e_nested_procvar_to_funcref);
  818. exit;
  819. end
  820. else
  821. pinested:=nil;
  822. if df_generic in owner.procdef.defoptions then
  823. exit;
  824. if not assigned(capturer) then
  825. capturer:=get_or_create_capturer(owner.procdef);
  826. if not (capturer.typ in [localvarsym,staticvarsym]) then
  827. internalerror(2022022103);
  828. capturedef:=tobjectdef(tabstractvarsym(capturer).vardef);
  829. if not is_class(capturedef) then
  830. internalerror(2022022104);
  831. implintf:=find_implemented_interface(capturedef,result);
  832. if assigned(implintf) then
  833. begin
  834. { this is already captured into a method of the capturer, so nothing
  835. further to do }
  836. exit;
  837. end;
  838. implintf:=capturedef.register_implemented_interface(result,true);
  839. invokename:=method_name_funcref_invoke_decl+'__FPCINTERNAL__'+fileinfo_to_suffix(sym.fileinfo);
  840. ps:=cprocsym.create(invokename);
  841. pd:=tprocdef(tabstractprocdef(n.resultdef).getcopyas(procdef,pc_normal,'',false));
  842. pd.aliasnames.clear;
  843. pd.procsym:=ps;
  844. pd.struct:=capturedef;
  845. pd.changeowner(capturedef.symtable);
  846. pd.parast.symtablelevel:=normal_function_level;
  847. pd.localst.symtablelevel:=normal_function_level;
  848. { reset procoptions }
  849. pd.procoptions:=[];
  850. { to simplify some checks }
  851. pd.was_anonymous:=true;
  852. ps.ProcdefList.Add(pd);
  853. pd.forwarddef:=false;
  854. { set procinfo and current_procinfo.procdef }
  855. pi:=tcgprocinfo(cprocinfo.create(nil));
  856. pi.procdef:=pd;
  857. if not assigned(pinested) then
  858. begin
  859. insert_funcret_local(pd);
  860. { we always do a call, namely to the provided function }
  861. include(pi.flags,pi_do_call);
  862. end
  863. else
  864. begin
  865. { the original nested function now calls the method }
  866. include(pinested.flags,pi_do_call);
  867. { swap the para and local symtables of the nested and new routine }
  868. swap_symtable(pinested.procdef.parast,pd.parast);
  869. swap_symtable(pinested.procdef.localst,pd.localst);
  870. { fix function return symbol }
  871. pd.funcretsym:=pinested.procdef.funcretsym;
  872. pinested.procdef.funcretsym:=nil;
  873. insert_funcret_local(pinested.procdef);
  874. end;
  875. capturedef.symtable.insertsym(ps);
  876. owner.addnestedproc(pi);
  877. { remove self and parentfp parameter if any as that will be replaced by
  878. the capturer }
  879. selfsym:=nil;
  880. fpsym:=nil;
  881. for i:=0 to pd.parast.symlist.count-1 do
  882. begin
  883. sym:=tsym(pd.parast.symlist[i]);
  884. if sym.typ<>paravarsym then
  885. continue;
  886. if vo_is_self in tparavarsym(sym).varoptions then
  887. selfsym:=sym
  888. else if vo_is_parentfp in tparavarsym(sym).varoptions then
  889. fpsym:=sym;
  890. if assigned(selfsym) and assigned(fpsym) then
  891. break;
  892. end;
  893. if assigned(selfsym) then
  894. pd.parast.deletesym(selfsym);
  895. if assigned(fpsym) then
  896. pd.parast.deletesym(fpsym);
  897. pd.calcparas;
  898. if assigned(pinested) then
  899. pinested.procdef.calcparas;
  900. insert_self_and_vmt_para(pd);
  901. if assigned(pinested) then
  902. begin
  903. { when we're assigning a nested function to a function reference we
  904. move the code of the nested function to the newly created capturer
  905. method (including the captured symbols) and have the original nested
  906. function simply call that function-turned-method }
  907. pi.code:=pinested.code;
  908. pinested.code:=internalstatements(stmt);
  909. end
  910. else
  911. pi.code:=internalstatements(stmt);
  912. selfinfo.selfsym:=nil;
  913. selfinfo.ignore:=nil;
  914. fieldsym:=nil;
  915. if assigned(pinested) then
  916. begin
  917. n1:=ccallnode.create(create_paras(pinested.procdef),ps,capturedef.symtable,cloadnode.create(capturer,capturer.owner),[],nil);
  918. { captured variables cannot be in registers }
  919. make_not_regable(tcallnode(n1).methodpointer,[ra_addr_regable,ra_addr_taken]);
  920. end
  921. else if n.resultdef.typ=procvardef then
  922. begin
  923. { store the procvar in a field so that it won't be changed if the
  924. procvar itself is changed }
  925. fieldsym:=cfieldvarsym.create('$'+fileinfo_to_suffix(n.fileinfo),vs_value,n.resultdef,[]);
  926. fieldsym.fileinfo:=n.fileinfo;
  927. capturedef.symtable.insertsym(fieldsym);
  928. tabstractrecordsymtable(capturedef.symtable).addfield(fieldsym,vis_public);
  929. capturen:=csubscriptnode.create(fieldsym,cloadnode.create(capturer,capturer.owner));
  930. selfsym:=tsym(pd.parast.find('self'));
  931. if not assigned(selfsym) then
  932. internalerror(2022052301);
  933. selfinfo.ignore:=selfsym;
  934. n1:=ccallnode.create_procvar(create_paras(pd),csubscriptnode.create(fieldsym,cloadnode.create(selfsym,selfsym.owner)));
  935. end
  936. else
  937. begin
  938. if n.nodetype<>loadn then
  939. internalerror(2022032401);
  940. if tloadnode(n).symtableentry.typ<>procsym then
  941. internalerror(2022032402);
  942. n1:=ccallnode.create(create_paras(pd),tprocsym(tloadnode(n).symtableentry),tloadnode(n).symtable,tloadnode(n).left,[],nil);
  943. tloadnode(n).left:=nil;
  944. end;
  945. if assigned(pd.returndef) and not is_void(pd.returndef) then
  946. begin
  947. n1:=cassignmentnode.create(
  948. cloadnode.create(pd.funcretsym,pd.localst),
  949. n1
  950. );
  951. { captured variables cannot be in registers }
  952. make_not_regable(tassignmentnode(n1).left,[ra_addr_regable,ra_addr_taken]);
  953. end;
  954. addstatement(stmt,n1);
  955. pd.aliasnames.insert(pd.mangledname);
  956. if assigned(pinested) then
  957. begin
  958. { transfer all captured syms }
  959. capturesyms:=pinested.procdef.capturedsyms;
  960. if assigned(capturesyms) then
  961. begin
  962. for i:=0 to capturesyms.count-1 do
  963. begin
  964. captured:=pcapturedsyminfo(capturesyms[i]);
  965. pi.add_captured_sym(captured^.sym,captured^.fileinfo);
  966. dispose(captured);
  967. end;
  968. capturesyms.clear;
  969. end;
  970. { the original nested function now needs to capture only the capturer }
  971. pinested.procdef.add_captured_sym(capturer,n.fileinfo);
  972. end
  973. { does this need to capture Self? }
  974. else if not foreachnodestatic(pm_postprocess,n,@find_self_sym,@selfinfo) then
  975. begin
  976. { does this need some other local variable or parameter? }
  977. foreachnodestatic(pm_postprocess,n,@collect_syms_to_capture,@pd)
  978. end
  979. else if not assigned(fieldsym) then
  980. { this isn't a procdef that was captured into a field, so capture the
  981. self }
  982. pd.add_captured_sym(selfinfo.selfsym,n.fileinfo);
  983. print_procinfo(pi);
  984. if assigned(pinested) then
  985. print_procinfo(pinested);
  986. implintf.AddMapping(upcase(result.objrealname^+'.')+method_name_funcref_invoke_find,upcase(invokename));
  987. capture_captured_syms(pd,owner,capturedef);
  988. end;
  989. function capturer_add_anonymous_proc(owner:tprocinfo;pd:tprocdef;out capturer:tsym):tobjectdef;
  990. var
  991. capturedef : tobjectdef;
  992. implintf : TImplementedInterface;
  993. invokename : tsymstr;
  994. i : longint;
  995. outerself,
  996. fpsym,
  997. selfsym,
  998. sym : tsym;
  999. info : pcapturedsyminfo;
  1000. pi : tprocinfo;
  1001. mapping : tsym_mapping;
  1002. invokedef,
  1003. parentdef,
  1004. curpd : tprocdef;
  1005. begin
  1006. capturer:=nil;
  1007. result:=funcref_intf_for_proc(pd,fileinfo_to_suffix(pd.fileinfo));
  1008. if df_generic in pd.defoptions then
  1009. begin
  1010. if (po_anonymous in pd.procoptions) and
  1011. assigned(pd.capturedsyms) and
  1012. (pd.capturedsyms.count>0) then
  1013. begin
  1014. { only check whether the symbols can be captured, but don't
  1015. convert anything to avoid problems }
  1016. for i:=0 to pd.capturedsyms.count-1 do
  1017. begin
  1018. info:=pcapturedsyminfo(pd.capturedsyms[i]);
  1019. if not can_be_captured(info^.sym) then
  1020. MessagePos1(info^.fileinfo,sym_e_symbol_no_capture,info^.sym.realname)
  1021. end;
  1022. end;
  1023. exit;
  1024. end;
  1025. capturer:=get_or_create_capturer(owner.procdef);
  1026. if not (capturer.typ in [localvarsym,staticvarsym]) then
  1027. internalerror(2022010711);
  1028. capturedef:=tobjectdef(tabstractvarsym(capturer).vardef);
  1029. if not is_class(capturedef) then
  1030. internalerror(2022010712);
  1031. implintf:=find_implemented_interface(capturedef,result);
  1032. if assigned(implintf) then
  1033. begin
  1034. { this can only already be an implemented interface if a named procdef
  1035. was assigned to a function ref at an earlier point, an anonymous
  1036. function can be used only once }
  1037. if po_anonymous in pd.procoptions then
  1038. internalerror(2022010713);
  1039. exit;
  1040. end;
  1041. implintf:=capturedef.register_implemented_interface(result,true);
  1042. invokename:=method_name_funcref_invoke_decl+'__FPCINTERNAL__'+fileinfo_to_suffix(pd.fileinfo);
  1043. if po_anonymous in pd.procoptions then
  1044. begin
  1045. { turn the anonymous function into a method of the capturer }
  1046. pd.changeowner(capturedef.symtable);
  1047. pd.struct:=capturedef;
  1048. exclude(pd.procoptions,po_anonymous);
  1049. exclude(pd.procoptions,po_delphi_nested_cc);
  1050. pd.was_anonymous:=true;
  1051. pd.procsym.ChangeOwnerAndName(capturedef.symtable,upcase(invokename));
  1052. pd.procsym.realname:=invokename;
  1053. pd.parast.symtablelevel:=normal_function_level;
  1054. pd.localst.symtablelevel:=normal_function_level;
  1055. { retrieve framepointer and self parameters if any }
  1056. fpsym:=nil;
  1057. selfsym:=nil;
  1058. for i:=0 to pd.parast.symlist.count-1 do
  1059. begin
  1060. sym:=tsym(pd.parast.symlist[i]);
  1061. if sym.typ<>paravarsym then
  1062. continue;
  1063. if vo_is_parentfp in tparavarsym(sym).varoptions then
  1064. fpsym:=sym
  1065. else if vo_is_self in tparavarsym(sym).varoptions then
  1066. selfsym:=sym;
  1067. if assigned(fpsym) and assigned(selfsym) then
  1068. break;
  1069. end;
  1070. { get rid of the framepointer parameter }
  1071. if assigned(fpsym) then
  1072. pd.parast.deletesym(fpsym);
  1073. outerself:=nil;
  1074. { complain about all symbols that can't be captured and add the symbols
  1075. to this procdefs capturedsyms if it isn't a top level function }
  1076. if assigned(pd.capturedsyms) and (pd.capturedsyms.count>0) then
  1077. begin
  1078. for i:=0 to pd.capturedsyms.count-1 do
  1079. begin
  1080. info:=pcapturedsyminfo(pd.capturedsyms[i]);
  1081. if not can_be_captured(info^.sym) then
  1082. MessagePos1(info^.fileinfo,sym_e_symbol_no_capture,info^.sym.realname)
  1083. else if info^.sym=selfsym then
  1084. begin
  1085. { we need to replace the captured "dummy" self parameter
  1086. with the real self parameter symbol from the surrounding
  1087. method }
  1088. if not assigned(outerself) then
  1089. outerself:=tsym(owner.get_normal_proc.procdef.parast.find('self'));
  1090. if not assigned(outerself) then
  1091. internalerror(2022010905);
  1092. { the anonymous function can only be a direct child of the
  1093. owner }
  1094. pi:=owner.get_first_nestedproc;
  1095. while assigned(pi) do
  1096. begin
  1097. if pi.procdef=pd then
  1098. break;
  1099. pi:=tprocinfo(pi.next);
  1100. end;
  1101. if not assigned(pi) then
  1102. internalerror(2022010906);
  1103. mapping.oldsym:=selfsym;
  1104. mapping.newsym:=outerself;
  1105. { replace all uses of the captured Self by the new Self
  1106. parameter }
  1107. foreachnodestatic(pm_preprocess,tcgprocinfo(pi).code,@replace_self_sym,@mapping);
  1108. { update the captured symbol }
  1109. info^.sym:=outerself;
  1110. end
  1111. else if info^.sym.owner.defowner<>owner.procdef then
  1112. owner.procdef.add_captured_sym(info^.sym,info^.fileinfo);
  1113. end;
  1114. end;
  1115. { delete the original self parameter }
  1116. if assigned(selfsym) then
  1117. pd.parast.deletesym(selfsym);
  1118. { note: don't call insert_self_and_vmt_para here, as that is later on
  1119. done when building the VMT }
  1120. end
  1121. else
  1122. internalerror(2022022201);
  1123. implintf.AddMapping(upcase(result.objrealname^+'.')+method_name_funcref_invoke_find,upcase(invokename));
  1124. capture_captured_syms(pd,owner,capturedef);
  1125. end;
  1126. function load_capturer(capturer:tabstractvarsym):tnode;inline;
  1127. begin
  1128. result:=cloadnode.create(capturer,capturer.owner);
  1129. end;
  1130. function instantiate_capturer(capturer_sym:tabstractvarsym):tnode;
  1131. var
  1132. capturer_def : tobjectdef;
  1133. ctor : tprocsym;
  1134. begin
  1135. capturer_def:=tobjectdef(capturer_sym.vardef);
  1136. { Neither TInterfacedObject, nor TCapturer have a custom constructor }
  1137. ctor:=tprocsym(class_tobject.symtable.Find('CREATE'));
  1138. if not assigned(ctor) then
  1139. internalerror(2022010801);
  1140. { Insert "Capturer := TCapturer.Create()" as the first statement of the routine }
  1141. result:=cloadvmtaddrnode.create(ctypenode.create(capturer_def));
  1142. result:=ccallnode.create(nil,ctor,capturer_def.symtable,result,[],nil);
  1143. result:=cassignmentnode.create(load_capturer(capturer_sym),result);
  1144. end;
  1145. procedure initialize_captured_paras(pd:tprocdef;capturer:tabstractvarsym;var stmt:tstatementnode);
  1146. var
  1147. i : longint;
  1148. psym: tparavarsym;
  1149. n : tnode;
  1150. begin
  1151. for i:=0 to pd.paras.count-1 do
  1152. begin
  1153. psym:=tparavarsym(pd.paras[i]);
  1154. if not psym.is_captured then
  1155. continue;
  1156. {$ifdef DEBUG_CAPTURER}writeln(#9'initialize captured parameter ',psym.RealName);{$endif}
  1157. n:=cloadnode.create(psym,psym.owner);
  1158. if psym.capture_sym.owner.defowner<>capturer.vardef then
  1159. internalerror(2022010903);
  1160. n:=cassignmentnode.create(
  1161. csubscriptnode.create(psym.capture_sym,cloadnode.create(capturer,capturer.owner)),
  1162. n
  1163. );
  1164. addstatement(stmt,n);
  1165. end;
  1166. end;
  1167. procedure attach_outer_capturer(ctx:tprocinfo;capturer:tabstractvarsym;var stmt:tstatementnode);
  1168. var
  1169. alivefield,
  1170. selffield : tfieldvarsym;
  1171. outeralive,
  1172. outercapturer : tabstractvarsym;
  1173. alivenode,
  1174. selfnode : tnode;
  1175. begin
  1176. if not ctx.procdef.was_anonymous and
  1177. not (ctx.procdef.owner.symtabletype=localsymtable) then
  1178. exit;
  1179. selffield:=tfieldvarsym(tobjectdef(capturer.vardef).symtable.find(outer_self_field_name));
  1180. if not assigned(selffield) then
  1181. { we'll simply assume that we don't need the outer capturer }
  1182. exit;
  1183. alivefield:=tfieldvarsym(tobjectdef(capturer.vardef).symtable.find(outer_self_field_name+keepalive_suffix));
  1184. if not assigned(alivefield) then
  1185. internalerror(2022051701);
  1186. if ctx.procdef.was_anonymous then
  1187. begin
  1188. selfnode:=load_self_node;
  1189. alivenode:=selfnode.getcopy;
  1190. end
  1191. else
  1192. begin
  1193. outercapturer:=get_capturer(tprocdef(ctx.procdef.owner.defowner));
  1194. if not assigned(outercapturer) then
  1195. internalerror(2022011605);
  1196. selfnode:=cloadnode.create(outercapturer,outercapturer.owner);
  1197. outeralive:=get_capturer_alive(tprocdef(ctx.procdef.owner.defowner));
  1198. if not assigned(outeralive) then
  1199. internalerror(2022051706);
  1200. alivenode:=cloadnode.create(outeralive,outeralive.owner);
  1201. end;
  1202. addstatement(stmt,cassignmentnode.create(
  1203. csubscriptnode.create(
  1204. selffield,
  1205. cloadnode.create(
  1206. capturer,
  1207. capturer.owner
  1208. )
  1209. ),
  1210. selfnode));
  1211. addstatement(stmt,cassignmentnode.create(
  1212. csubscriptnode.create(
  1213. alivefield,
  1214. cloadnode.create(
  1215. capturer,
  1216. capturer.owner
  1217. )
  1218. ),
  1219. alivenode));
  1220. end;
  1221. procedure initialize_capturer(ctx:tprocinfo;var stmt:tstatementnode);
  1222. var
  1223. capturer_sym,
  1224. keepalive_sym : tabstractvarsym;
  1225. begin
  1226. if ctx.procdef.has_capturer then
  1227. begin
  1228. capturer_sym:=get_capturer(ctx.procdef);
  1229. {$ifdef DEBUG_CAPTURER}writeln('initialize_capturer @ ',ctx.procdef.procsym.RealName);{$endif}
  1230. addstatement(stmt,instantiate_capturer(capturer_sym));
  1231. attach_outer_capturer(ctx,capturer_sym,stmt);
  1232. initialize_captured_paras(ctx.procdef,capturer_sym,stmt);
  1233. keepalive_sym:=get_capturer_alive(ctx.procdef);
  1234. if not assigned(keepalive_sym) then
  1235. internalerror(2022010701);
  1236. addstatement(stmt,cassignmentnode.create(cloadnode.create(keepalive_sym,keepalive_sym.owner),load_capturer(capturer_sym)));
  1237. end;
  1238. end;
  1239. procedure postprocess_capturer(ctx: tprocinfo);
  1240. var
  1241. def: tobjectdef;
  1242. begin
  1243. if not ctx.procdef.has_capturer then
  1244. exit;
  1245. def:=tobjectdef(get_capturer(ctx.procdef).vardef);
  1246. {$ifdef DEBUG_CAPTURER}writeln('process capturer ',def.typesym.Name);{$endif}
  1247. { These two are delayed until this point because
  1248. ... we have been adding fields on-the-fly }
  1249. tabstractrecordsymtable(def.symtable).addalignmentpadding;
  1250. { ... we have been adding interfaces on-the-fly }
  1251. build_vmt(def);
  1252. end;
  1253. type
  1254. tconvert_arg=record
  1255. mappings:tfplist;
  1256. end;
  1257. pconvert_arg=^tconvert_arg;
  1258. tconvert_mapping=record
  1259. oldsym:tsym;
  1260. newsym:tsym;
  1261. selfnode:tnode;
  1262. end;
  1263. pconvert_mapping=^tconvert_mapping;
  1264. function convert_captured_sym(var n:tnode;arg:pointer):foreachnoderesult;
  1265. var
  1266. convertarg : pconvert_arg absolute arg;
  1267. mapping : pconvert_mapping;
  1268. i : longint;
  1269. old_filepos : tfileposinfo;
  1270. loadprocvar : boolean;
  1271. begin
  1272. result:=fen_true;
  1273. if n.nodetype<>loadn then
  1274. exit;
  1275. for i:=0 to convertarg^.mappings.count-1 do
  1276. begin
  1277. mapping:=convertarg^.mappings[i];
  1278. if tloadnode(n).symtableentry<>mapping^.oldsym then
  1279. continue;
  1280. old_filepos:=current_filepos;
  1281. current_filepos:=n.fileinfo;
  1282. loadprocvar:=nf_load_procvar in n.flags;
  1283. n.free;
  1284. n:=csubscriptnode.create(mapping^.newsym,mapping^.selfnode.getcopy);
  1285. if loadprocvar then
  1286. include(n.flags,nf_load_procvar);
  1287. typecheckpass(n);
  1288. current_filepos:=old_filepos;
  1289. break;
  1290. end;
  1291. end;
  1292. procedure convert_captured_syms(pd:tprocdef;tree:tnode);
  1293. function self_tree_for_sym(selfsym:tsym;fieldsym:tsym):tnode;
  1294. var
  1295. fieldowner : tdef;
  1296. newsym : tsym;
  1297. begin
  1298. result:=cloadnode.create(selfsym,selfsym.owner);
  1299. fieldowner:=tdef(fieldsym.owner.defowner);
  1300. newsym:=selfsym;
  1301. while (tabstractvarsym(newsym).vardef<>fieldowner) do
  1302. begin
  1303. newsym:=tsym(tobjectdef(tabstractvarsym(newsym).vardef).symtable.find(outer_self_field_name));
  1304. if not assigned(newsym) then
  1305. internalerror(2022011101);
  1306. result:=csubscriptnode.create(newsym,result);
  1307. end;
  1308. end;
  1309. var
  1310. i,j : longint;
  1311. capturer : tobjectdef;
  1312. tocapture,
  1313. capturedsyms : tfplist;
  1314. convertarg : tconvert_arg;
  1315. mapping : pconvert_mapping;
  1316. invokepd : tprocdef;
  1317. selfsym,
  1318. sym : tsym;
  1319. info: pcapturedsyminfo;
  1320. begin
  1321. {$ifdef DEBUG_CAPTURER}writeln('Converting captured symbols of ',pd.procsym.name);{$endif}
  1322. convertarg.mappings:=tfplist.create;
  1323. capturedsyms:=tfplist.create;
  1324. if pd.was_anonymous and
  1325. assigned(pd.capturedsyms) and
  1326. (pd.capturedsyms.count>0) then
  1327. begin
  1328. {$ifdef DEBUG_CAPTURER}writeln('Converting symbols of converted anonymous function ',pd.procsym.name);{$endif}
  1329. { this is a converted anonymous function, so rework all symbols that
  1330. now belong to the new Self }
  1331. selfsym:=tsym(pd.parast.find('self'));
  1332. if not assigned(selfsym) then
  1333. internalerror(2022010809);
  1334. for i:=0 to pd.capturedsyms.count-1 do
  1335. begin
  1336. sym:=tsym(pcapturedsyminfo(pd.capturedsyms[i])^.sym);
  1337. if not can_be_captured(sym) then
  1338. continue;
  1339. {$ifdef DEBUG_CAPTURER}writeln('Replacing symbol ',sym.Name);{$endif}
  1340. new(mapping);
  1341. mapping^.oldsym:=sym;
  1342. mapping^.newsym:=tabstractnormalvarsym(sym).capture_sym;
  1343. if not assigned(mapping^.newsym) then
  1344. internalerror(2022010810);
  1345. mapping^.selfnode:=self_tree_for_sym(selfsym,mapping^.newsym);
  1346. convertarg.mappings.add(mapping);
  1347. capturedsyms.add(sym);
  1348. end;
  1349. end;
  1350. if (pd.parast.symtablelevel>normal_function_level) and
  1351. assigned(pd.capturedsyms) and
  1352. (pd.capturedsyms.count>0) then
  1353. begin
  1354. if pd.was_anonymous then
  1355. internalerror(2022081201);
  1356. {$ifdef DEBUG_CAPTURER}writeln('Converting symbols of nested function ',pd.procsym.name);{$endif}
  1357. { this is a nested function, so rework all symbols that are used from
  1358. a parent function, but that might have been captured }
  1359. for i:=0 to pd.capturedsyms.count-1 do
  1360. begin
  1361. sym:=tsym(pcapturedsyminfo(pd.capturedsyms[i])^.sym);
  1362. if not can_be_captured(sym) or not assigned(tabstractnormalvarsym(sym).capture_sym) then
  1363. continue;
  1364. {$ifdef DEBUG_CAPTURER}writeln('Replacing symbol ',sym.Name);{$endif}
  1365. new(mapping);
  1366. mapping^.oldsym:=sym;
  1367. mapping^.newsym:=tabstractnormalvarsym(sym).capture_sym;
  1368. capturer:=tobjectdef(mapping^.newsym.owner.defowner);
  1369. if not is_class(capturer) then
  1370. internalerror(2022012701);
  1371. if not (capturer.typesym.owner.symtabletype in [localsymtable,staticsymtable]) then
  1372. internalerror(2022012702);
  1373. selfsym:=tsym(capturer.typesym.owner.find(capturer_var_name));
  1374. if not assigned(selfsym) then
  1375. internalerror(2022012703);
  1376. mapping^.selfnode:=self_tree_for_sym(selfsym,mapping^.newsym);
  1377. convertarg.mappings.add(mapping);
  1378. capturedsyms.add(sym);
  1379. end;
  1380. end;
  1381. if pd.has_capturer then
  1382. begin
  1383. {$ifdef DEBUG_CAPTURER}writeln('Converting symbols of function ',pd.procsym.name,' with capturer');{$endif}
  1384. { this procedure has a capturer, so rework all symbols that are
  1385. captured in that capturer }
  1386. selfsym:=get_capturer(pd);
  1387. { only capture those symbols that weren't capture already by one of
  1388. the above if-clauses and thus are now listed in capturedsyms }
  1389. tocapture:=tfplist.create;
  1390. for i:=0 to pd.localst.symlist.count-1 do
  1391. begin
  1392. sym:=tsym(pd.localst.symlist[i]);
  1393. if sym.typ<>localvarsym then
  1394. continue;
  1395. if assigned(tabstractnormalvarsym(sym).capture_sym) then
  1396. if capturedsyms.indexof(sym)<0 then
  1397. tocapture.add(sym);
  1398. end;
  1399. for i:=0 to pd.parast.symlist.count-1 do
  1400. begin
  1401. sym:=tsym(pd.parast.symlist[i]);
  1402. if sym.typ<>paravarsym then
  1403. continue;
  1404. if assigned(tabstractnormalvarsym(sym).capture_sym) and
  1405. { no need to adjust accesses to the outermost Self inside the
  1406. outermost method }
  1407. not (vo_is_self in tabstractvarsym(sym).varoptions) then
  1408. if capturedsyms.indexof(sym)<0 then
  1409. tocapture.add(sym);
  1410. end;
  1411. for i:=0 to tocapture.count-1 do
  1412. begin
  1413. new(mapping);
  1414. mapping^.oldsym:=tsym(tocapture[i]);
  1415. {$ifdef DEBUG_CAPTURER}writeln('Replacing symbol ',mapping^.oldsym.Name);{$endif}
  1416. mapping^.newsym:=tabstractnormalvarsym(mapping^.oldsym).capture_sym;
  1417. if not assigned(mapping^.newsym) then
  1418. internalerror(2022010805);
  1419. mapping^.selfnode:=self_tree_for_sym(selfsym,mapping^.newsym);
  1420. convertarg.mappings.add(mapping);
  1421. end;
  1422. tocapture.free;
  1423. end;
  1424. { not required anymore }
  1425. capturedsyms.free;
  1426. foreachnodestatic(pm_postprocess,tree,@convert_captured_sym,@convertarg);
  1427. for i:=0 to convertarg.mappings.count-1 do
  1428. begin
  1429. mapping:=pconvert_mapping(convertarg.mappings[i]);
  1430. mapping^.selfnode.free;
  1431. dispose(mapping);
  1432. end;
  1433. convertarg.mappings.free;
  1434. end;
  1435. end.