procdefutil.pas 55 KB

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