procdefutil.pas 59 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648
  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. include(def.objectoptions,oo_is_capturer);
  400. typesym:=ctypesym.create(name,def);
  401. typesym.fileinfo:=pd.fileinfo;
  402. st.insertdef(def);
  403. st.insertsym(typesym);
  404. addsymref(typesym);
  405. if df_generic in pd.defoptions then
  406. include(def.defoptions,df_generic);
  407. { don't set df_specialization as in that case genericdef needs to be
  408. set, but the local symtables are freed once a unit is finished }
  409. {if df_specialization in pd.defoptions then
  410. begin
  411. if not assigned(pd.genericdef) or (pd.genericdef.typ<>procdef) then
  412. internalerror(2022020501);
  413. def.genericdef:=tstoreddef(get_capturer(tprocdef(pd.genericdef)).vardef);
  414. include(def.defoptions,df_specialization);
  415. end;}
  416. if st.symtabletype=localsymtable then
  417. result:=clocalvarsym.create('$'+capturer_var_name,vs_value,def,[vo_is_internal])
  418. else
  419. result:=cstaticvarsym.create('$'+capturer_var_name,vs_value,def,[vo_is_internal]);
  420. result.fileinfo:=pd.fileinfo;
  421. st.insertsym(result);
  422. addsymref(result);
  423. if st.symtabletype=localsymtable then
  424. keepalive:=clocalvarsym.create('$'+capturer_var_name+keepalive_suffix,vs_value,interface_iunknown,[vo_is_internal])
  425. else
  426. keepalive:=cstaticvarsym.create('$'+capturer_var_name+keepalive_suffix,vs_value,interface_iunknown,[vo_is_internal]);
  427. keepalive.fileinfo:=pd.fileinfo;
  428. st.insertsym(keepalive);
  429. addsymref(keepalive);
  430. if st.symtabletype<>localsymtable then
  431. begin
  432. cnodeutils.insertbssdata(tstaticvarsym(result));
  433. cnodeutils.insertbssdata(tstaticvarsym(keepalive));
  434. end;
  435. { avoid warnings as these symbols are initialized using initialize_capturer
  436. after parsing the body }
  437. tabstractvarsym(result).varstate:=vs_readwritten;
  438. keepalive.varstate:=vs_readwritten;
  439. pd.has_capturer:=true;
  440. end;
  441. end;
  442. function can_be_captured(sym:tsym):boolean;
  443. begin
  444. result:=false;
  445. if not (sym.typ in [localvarsym,paravarsym]) then
  446. exit;
  447. if tabstractnormalvarsym(sym).varoptions*[vo_is_result,vo_is_funcret]<>[] then
  448. exit;
  449. if sym.typ=paravarsym then
  450. begin
  451. if (tparavarsym(sym).varspez in [vs_out,vs_var]) and
  452. not (vo_is_self in tparavarsym(sym).varoptions) then
  453. exit;
  454. if is_open_array(tparavarsym(sym).vardef) then
  455. exit;
  456. end;
  457. result:=true;
  458. end;
  459. type
  460. tsym_mapping = record
  461. oldsym:tsym;
  462. newsym:tsym;
  463. end;
  464. psym_mapping = ^tsym_mapping;
  465. function replace_self_sym(var n:tnode;arg:pointer):foreachnoderesult;
  466. var
  467. mapping : psym_mapping absolute arg;
  468. ld : tloadnode;
  469. begin
  470. if n.nodetype=loadn then
  471. begin
  472. ld:=tloadnode(n);
  473. if ld.symtableentry=mapping^.oldsym then
  474. begin
  475. ld.symtableentry:=mapping^.newsym;
  476. { make sure that the node is processed again }
  477. ld.resultdef:=nil;
  478. if assigned(ld.left) then
  479. begin
  480. { no longer loaded through the frame pointer }
  481. ld.left.free;
  482. ld.left:=nil;
  483. end;
  484. typecheckpass(n);
  485. end;
  486. end;
  487. result:=fen_true;
  488. end;
  489. procedure capture_captured_syms(pd:tprocdef;owner:tprocinfo;capturedef:tobjectdef);
  490. var
  491. curpd : tprocdef;
  492. subcapturer : tobjectdef;
  493. symstodo : TFPList;
  494. i : longint;
  495. sym : tsym;
  496. fieldsym : tfieldvarsym;
  497. fieldname : tsymstr;
  498. fielddef : tdef;
  499. begin
  500. if not pd.was_anonymous or not assigned(pd.capturedsyms) or (pd.capturedsyms.count=0) then
  501. exit;
  502. { capture all variables that the original procdef captured }
  503. curpd:=owner.procdef;
  504. subcapturer:=capturedef;
  505. symstodo:=tfplist.create;
  506. for i:=0 to pd.capturedsyms.count-1 do
  507. if can_be_captured(pcapturedsyminfo(pd.capturedsyms[i])^.sym) then
  508. symstodo.add(pcapturedsyminfo(pd.capturedsyms[i])^.sym);
  509. while symstodo.count>0 do
  510. begin
  511. { we know we have symbols left to capture thus we either have a
  512. symbol that's located in the capturer of the current procdef or
  513. we need to put in the OuterSelf reference }
  514. if curpd=owner.procdef then
  515. subcapturer:=capturedef
  516. else
  517. subcapturer:=tobjectdef(tabstractvarsym(get_or_create_capturer(curpd)).vardef);
  518. i:=0;
  519. while i<symstodo.count do
  520. begin
  521. sym:=tsym(symstodo[i]);
  522. if (sym.owner=curpd.localst) or
  523. (sym.owner=curpd.parast) then
  524. begin
  525. {$ifdef DEBUG_CAPTURER}writeln('Symbol ',sym.name,' captured from ',curpd.procsym.name);{$endif}
  526. { the symbol belongs to the current procdef, so add a field to
  527. the capturer if it doesn't already exist }
  528. if vo_is_self in tabstractnormalvarsym(sym).varoptions then
  529. fieldname:=outer_self_field_name
  530. else
  531. fieldname:=sym.name;
  532. fieldsym:=tfieldvarsym(subcapturer.symtable.find(fieldname));
  533. if not assigned(fieldsym) then
  534. begin
  535. {$ifdef DEBUG_CAPTURER}writeln('Adding field ',fieldname,' to ',subcapturer.typesym.name);{$endif}
  536. fielddef:=tabstractvarsym(sym).vardef;
  537. if vo_is_self in tabstractnormalvarsym(sym).varoptions then
  538. begin
  539. fieldname:='$'+fieldname;
  540. if not is_implicit_pointer_object_type(fielddef) then
  541. fielddef:=cpointerdef.getreusable(fielddef);
  542. end;
  543. fieldsym:=cfieldvarsym.create(fieldname,vs_value,fielddef,[]);
  544. fieldsym.fileinfo:=sym.fileinfo;
  545. subcapturer.symtable.insertsym(fieldsym);
  546. tabstractrecordsymtable(subcapturer.symtable).addfield(fieldsym,vis_public);
  547. end;
  548. if not assigned(tabstractnormalvarsym(sym).capture_sym) then
  549. tabstractnormalvarsym(sym).capture_sym:=fieldsym
  550. else if tabstractnormalvarsym(sym).capture_sym<>fieldsym then
  551. internalerror(2022011602);
  552. symstodo.delete(i);
  553. end
  554. else
  555. inc(i);
  556. end;
  557. if symstodo.count>0 then
  558. begin
  559. if curpd.owner.symtabletype<>localsymtable then
  560. internalerror(2022011001);
  561. { there are still symbols left, so before we move to the parent
  562. procdef we add the OuterSelf field to set up the chain of
  563. capturers }
  564. {$ifdef DEBUG_CAPTURER}writeln('Initialize capturer for ',curpd.procsym.name);{$endif}
  565. { we no longer need the curpd, but we need the parent, so change
  566. curpd here }
  567. curpd:=tprocdef(curpd.owner.defowner);
  568. if curpd.typ<>procdef then
  569. internalerror(2022011002);
  570. if not assigned(subcapturer.symtable.find(outer_self_field_name)) then
  571. begin
  572. {$ifdef DEBUG_CAPTURER}writeln('Adding field OuterSelf to ',subcapturer.typesym.name);{$endif}
  573. if subcapturer.owner.symtablelevel>normal_function_level then
  574. { the outer self is the capturer of the outer procdef }
  575. sym:=get_or_create_capturer(curpd)
  576. else
  577. begin
  578. { the outer self is the self of the method }
  579. if not (curpd.owner.symtabletype in [objectsymtable,recordsymtable]) then
  580. internalerror(2022011603);
  581. sym:=tsym(curpd.parast.find('self'));
  582. if not assigned(sym) then
  583. internalerror(2022011604);
  584. end;
  585. { add the keep alive IUnknown symbol }
  586. fieldsym:=cfieldvarsym.create('$'+outer_self_field_name+keepalive_suffix,vs_value,interface_iunknown,[]);
  587. fieldsym.fileinfo:=sym.fileinfo;
  588. subcapturer.symtable.insertsym(fieldsym);
  589. tabstractrecordsymtable(subcapturer.symtable).addfield(fieldsym,vis_public);
  590. { add the capturer symbol }
  591. fieldsym:=cfieldvarsym.create('$'+outer_self_field_name,vs_value,tabstractvarsym(sym).vardef,[]);
  592. fieldsym.fileinfo:=sym.fileinfo;
  593. subcapturer.symtable.insertsym(fieldsym);
  594. tabstractrecordsymtable(subcapturer.symtable).addfield(fieldsym,vis_public);
  595. if (sym.typ=paravarsym) and (vo_is_self in tparavarsym(sym).varoptions) then
  596. begin
  597. if assigned(tparavarsym(sym).capture_sym) then
  598. internalerror(2022011705);
  599. tparavarsym(sym).capture_sym:=fieldsym;
  600. end;
  601. end;
  602. end;
  603. end;
  604. symstodo.free;
  605. end;
  606. function retrieve_sym_for_filepos(var n:tnode;arg:pointer):foreachnoderesult;
  607. var
  608. sym : ^tsym absolute arg;
  609. begin
  610. if assigned(sym^) then
  611. exit(fen_norecurse_true);
  612. result:=fen_false;
  613. if not (n.resultdef.typ in [procdef,procvardef]) then
  614. exit;
  615. if n.nodetype=loadn then
  616. begin
  617. sym^:=tloadnode(n).symtableentry;
  618. result:=fen_norecurse_true;
  619. end
  620. else if n.nodetype=subscriptn then
  621. begin
  622. sym^:=tsubscriptnode(n).vs;
  623. result:=fen_norecurse_true;
  624. end;
  625. end;
  626. function collect_syms_to_capture(var n:tnode;arg:pointer):foreachnoderesult;
  627. var
  628. pd : tprocdef absolute arg;
  629. sym : tsym;
  630. begin
  631. result:=fen_false;
  632. if n.nodetype<>loadn then
  633. exit;
  634. sym:=tsym(tloadnode(n).symtableentry);
  635. if not (sym.owner.symtabletype in [parasymtable,localsymtable]) then
  636. exit;
  637. if sym.owner.symtablelevel>normal_function_level then begin
  638. pd.add_captured_sym(sym,n.fileinfo);
  639. result:=fen_true;
  640. end;
  641. end;
  642. type
  643. tselfinfo=record
  644. selfsym:tsym;
  645. ignore:tsym;
  646. end;
  647. pselfinfo=^tselfinfo;
  648. function find_self_sym(var n:tnode;arg:pointer):foreachnoderesult;
  649. var
  650. info : pselfinfo absolute arg;
  651. begin
  652. result:=fen_false;
  653. if assigned(info^.selfsym) then
  654. exit(fen_norecurse_true);
  655. if n.nodetype<>loadn then
  656. exit;
  657. if tloadnode(n).symtableentry.typ<>paravarsym then
  658. exit;
  659. if tloadnode(n).symtableentry=info^.ignore then
  660. exit;
  661. if vo_is_self in tparavarsym(tloadnode(n).symtableentry).varoptions then
  662. begin
  663. info^.selfsym:=tparavarsym(tloadnode(n).symtableentry);
  664. result:=fen_norecurse_true;
  665. end;
  666. end;
  667. function find_outermost_loaded_sym(var n:tnode;arg:pointer):foreachnoderesult;
  668. var
  669. sym : ^tsym absolute arg;
  670. begin
  671. if assigned(sym^) then
  672. exit(fen_norecurse_true);
  673. result:=fen_false;
  674. if n.nodetype<>loadn then
  675. exit;
  676. if not (n.resultdef.typ in [procdef,procvardef]) then
  677. exit;
  678. sym^:=tloadnode(n).symtableentry;
  679. result:=fen_norecurse_true;
  680. end;
  681. function find_procdef(var n:tnode;arg:pointer):foreachnoderesult;
  682. var
  683. pd : ^tprocdef absolute arg;
  684. begin
  685. if assigned(pd^) then
  686. exit(fen_norecurse_true);
  687. result:=fen_false;
  688. if n.resultdef.typ<>procdef then
  689. exit;
  690. pd^:=tprocdef(n.resultdef);
  691. result:=fen_norecurse_true;
  692. end;
  693. function capturer_add_procvar_or_proc(owner:tprocinfo;n:tnode;out capturer:tsym;out capturen:tnode):tobjectdef;
  694. function create_paras(pd:tprocdef):tcallparanode;
  695. var
  696. para : tparavarsym;
  697. i : longint;
  698. begin
  699. result:=nil;
  700. for i:=0 to pd.paras.count-1 do
  701. begin
  702. para:=tparavarsym(pd.paras[i]);
  703. if vo_is_hidden_para in para.varoptions then
  704. continue;
  705. result:=ccallparanode.create(cloadnode.create(para,pd.parast),result);
  706. end;
  707. end;
  708. function find_nested_procinfo(pd:tprocdef):tcgprocinfo;
  709. var
  710. tmp,
  711. res : tprocinfo;
  712. begin
  713. tmp:=owner;
  714. while assigned(tmp) and (tmp.procdef.parast.symtablelevel>=normal_function_level) do
  715. begin
  716. res:=tmp.find_nestedproc_by_pd(pd);
  717. if assigned(res) then
  718. exit(tcgprocinfo(res));
  719. tmp:=tmp.parent;
  720. end;
  721. result:=nil;
  722. end;
  723. procedure swap_symtable(var st1,st2:tsymtable);
  724. var
  725. st : tsymtable;
  726. owner : tdefentry;
  727. level : byte;
  728. begin
  729. { first swap the symtables themselves }
  730. st:=st1;
  731. st1:=st2;
  732. st2:=st;
  733. { then swap the symtables' owners }
  734. owner:=st1.defowner;
  735. st1.defowner:=st2.defowner;
  736. st2.defowner:=owner;
  737. { and finally the symtable level }
  738. level:=st1.symtablelevel;
  739. st1.symtablelevel:=st2.symtablelevel;
  740. st2.symtablelevel:=level;
  741. end;
  742. procedure print_procinfo(pi:tcgprocinfo);
  743. begin
  744. { Print the node to tree.log }
  745. if paraprintnodetree <> 0 then
  746. pi.printproc('after parsing');
  747. {$ifdef DEBUG_NODE_XML}
  748. { Methods of generic classes don't get any code generated, so output
  749. the node tree here }
  750. if (df_generic in pi.procdef.defoptions) then
  751. pi.XMLPrintProc(True);
  752. {$endif DEBUG_NODE_XML}
  753. end;
  754. var
  755. ps : tprocsym;
  756. pd : tprocdef;
  757. pinested,
  758. pi : tcgprocinfo;
  759. sym,
  760. fpsym,
  761. selfsym : tsym;
  762. invokename : tsymstr;
  763. capturedef : tobjectdef;
  764. capturesyms : tfplist;
  765. captured : pcapturedsyminfo;
  766. implintf : TImplementedInterface;
  767. i : longint;
  768. stmt : tstatementnode;
  769. n1 : tnode;
  770. fieldsym : tfieldvarsym;
  771. selfinfo : tselfinfo;
  772. begin
  773. if not (n.resultdef.typ in [procdef,procvardef]) then
  774. internalerror(2022022101);
  775. capturer:=nil;
  776. capturen:=nil;
  777. pinested:=nil;
  778. { determine a unique name for the variable, field for function of the
  779. node we're trying to load }
  780. sym:=nil;
  781. if not foreachnodestatic(pm_preprocess,n,@find_outermost_loaded_sym,@sym) then
  782. internalerror(2022022102);
  783. result:=funcref_intf_for_proc(tabstractprocdef(n.resultdef),fileinfo_to_suffix(sym.fileinfo));
  784. if (sym.typ=procsym) and (sym.owner.symtabletype=localsymtable) then
  785. begin
  786. { this is assigning a nested function, so retrieve the correct procdef
  787. so that we can then retrieve the procinfo for it }
  788. if n.resultdef.typ=procdef then
  789. pd:=tprocdef(n.resultdef)
  790. else
  791. begin
  792. pd:=nil;
  793. if not foreachnodestatic(pm_preprocess,n,@find_procdef,@pd) then
  794. internalerror(2022041801);
  795. if not assigned(pd) then
  796. internalerror(2022041802);
  797. end;
  798. { check whether all captured symbols can indeed be captured }
  799. capturesyms:=pd.capturedsyms;
  800. if assigned(capturesyms) then
  801. for i:=0 to capturesyms.count-1 do
  802. begin
  803. captured:=pcapturedsyminfo(capturesyms[i]);
  804. if not can_be_captured(captured^.sym) then
  805. MessagePos1(captured^.fileinfo,sym_e_symbol_no_capture,captured^.sym.realname);
  806. end;
  807. if not (df_generic in owner.procdef.defoptions) then
  808. begin
  809. pinested:=find_nested_procinfo(pd);
  810. if not assigned(pinested) then
  811. internalerror(2022041803);
  812. if pinested.parent<>owner then
  813. begin
  814. { we need to capture this into the owner of the nested function
  815. instead }
  816. owner:=pinested;
  817. capturer:=get_or_create_capturer(pinested.procdef);
  818. if not assigned(capturer) then
  819. internalerror(2022041804);
  820. end;
  821. end;
  822. end
  823. else if (n.resultdef.typ=procvardef) and
  824. (po_delphi_nested_cc in tprocvardef(n.resultdef).procoptions) then
  825. begin
  826. MessagePos(n.fileinfo,type_e_nested_procvar_to_funcref);
  827. exit;
  828. end
  829. else
  830. pinested:=nil;
  831. if df_generic in owner.procdef.defoptions then
  832. exit;
  833. if not assigned(capturer) then
  834. capturer:=get_or_create_capturer(owner.procdef);
  835. if not (capturer.typ in [localvarsym,staticvarsym]) then
  836. internalerror(2022022103);
  837. capturedef:=tobjectdef(tabstractvarsym(capturer).vardef);
  838. if not is_class(capturedef) then
  839. internalerror(2022022104);
  840. implintf:=find_implemented_interface(capturedef,result);
  841. if assigned(implintf) then
  842. begin
  843. { this is already captured into a method of the capturer, so nothing
  844. further to do }
  845. exit;
  846. end;
  847. implintf:=capturedef.register_implemented_interface(result,true);
  848. invokename:=method_name_funcref_invoke_decl+'__FPCINTERNAL__'+fileinfo_to_suffix(sym.fileinfo);
  849. ps:=cprocsym.create(invokename);
  850. pd:=tprocdef(tabstractprocdef(n.resultdef).getcopyas(procdef,pc_normal,'',false));
  851. pd.aliasnames.clear;
  852. pd.procsym:=ps;
  853. pd.struct:=capturedef;
  854. pd.changeowner(capturedef.symtable);
  855. pd.parast.symtablelevel:=normal_function_level;
  856. pd.localst.symtablelevel:=normal_function_level;
  857. { reset procoptions }
  858. pd.procoptions:=[];
  859. { to simplify some checks }
  860. pd.was_anonymous:=true;
  861. ps.ProcdefList.Add(pd);
  862. pd.forwarddef:=false;
  863. { set procinfo and current_procinfo.procdef }
  864. pi:=tcgprocinfo(cprocinfo.create(nil));
  865. pi.procdef:=pd;
  866. if not assigned(pinested) then
  867. begin
  868. insert_funcret_local(pd);
  869. { we always do a call, namely to the provided function }
  870. include(pi.flags,pi_do_call);
  871. end
  872. else
  873. begin
  874. { the original nested function now calls the method }
  875. include(pinested.flags,pi_do_call);
  876. { swap the para and local symtables of the nested and new routine }
  877. swap_symtable(pinested.procdef.parast,pd.parast);
  878. swap_symtable(pinested.procdef.localst,pd.localst);
  879. { fix function return symbol }
  880. pd.funcretsym:=pinested.procdef.funcretsym;
  881. pinested.procdef.funcretsym:=nil;
  882. insert_funcret_local(pinested.procdef);
  883. end;
  884. capturedef.symtable.insertsym(ps);
  885. owner.addnestedproc(pi);
  886. { remove self and parentfp parameter if any as that will be replaced by
  887. the capturer }
  888. selfsym:=nil;
  889. fpsym:=nil;
  890. for i:=0 to pd.parast.symlist.count-1 do
  891. begin
  892. sym:=tsym(pd.parast.symlist[i]);
  893. if sym.typ<>paravarsym then
  894. continue;
  895. if vo_is_self in tparavarsym(sym).varoptions then
  896. selfsym:=sym
  897. else if vo_is_parentfp in tparavarsym(sym).varoptions then
  898. fpsym:=sym;
  899. if assigned(selfsym) and assigned(fpsym) then
  900. break;
  901. end;
  902. if assigned(selfsym) then
  903. pd.parast.deletesym(selfsym);
  904. if assigned(fpsym) then
  905. pd.parast.deletesym(fpsym);
  906. pd.calcparas;
  907. if assigned(pinested) then
  908. pinested.procdef.calcparas;
  909. insert_self_and_vmt_para(pd);
  910. if assigned(pinested) then
  911. begin
  912. { when we're assigning a nested function to a function reference we
  913. move the code of the nested function to the newly created capturer
  914. method (including the captured symbols) and have the original nested
  915. function simply call that function-turned-method }
  916. pi.code:=pinested.code;
  917. pinested.code:=internalstatements(stmt);
  918. end
  919. else
  920. pi.code:=internalstatements(stmt);
  921. selfinfo.selfsym:=nil;
  922. selfinfo.ignore:=nil;
  923. fieldsym:=nil;
  924. if assigned(pinested) then
  925. begin
  926. n1:=ccallnode.create(create_paras(pinested.procdef),ps,capturedef.symtable,cloadnode.create(capturer,capturer.owner),[],nil);
  927. { captured variables cannot be in registers }
  928. make_not_regable(tcallnode(n1).methodpointer,[ra_addr_regable,ra_addr_taken]);
  929. end
  930. else if n.resultdef.typ=procvardef then
  931. begin
  932. { store the procvar in a field so that it won't be changed if the
  933. procvar itself is changed }
  934. fieldsym:=cfieldvarsym.create('$'+fileinfo_to_suffix(n.fileinfo),vs_value,n.resultdef,[]);
  935. fieldsym.fileinfo:=n.fileinfo;
  936. capturedef.symtable.insertsym(fieldsym);
  937. tabstractrecordsymtable(capturedef.symtable).addfield(fieldsym,vis_public);
  938. capturen:=csubscriptnode.create(fieldsym,cloadnode.create(capturer,capturer.owner));
  939. selfsym:=tsym(pd.parast.find('self'));
  940. if not assigned(selfsym) then
  941. internalerror(2022052301);
  942. selfinfo.ignore:=selfsym;
  943. n1:=ccallnode.create_procvar(create_paras(pd),csubscriptnode.create(fieldsym,cloadnode.create(selfsym,selfsym.owner)));
  944. end
  945. else
  946. begin
  947. if n.nodetype<>loadn then
  948. internalerror(2022032401);
  949. if tloadnode(n).symtableentry.typ<>procsym then
  950. internalerror(2022032402);
  951. n1:=ccallnode.create(create_paras(pd),tprocsym(tloadnode(n).symtableentry),tloadnode(n).symtable,tloadnode(n).left,[],nil);
  952. tloadnode(n).left:=nil;
  953. end;
  954. if assigned(pd.returndef) and not is_void(pd.returndef) then
  955. begin
  956. n1:=cassignmentnode.create(
  957. cloadnode.create(pd.funcretsym,pd.localst),
  958. n1
  959. );
  960. { captured variables cannot be in registers }
  961. make_not_regable(tassignmentnode(n1).left,[ra_addr_regable,ra_addr_taken]);
  962. end;
  963. addstatement(stmt,n1);
  964. pd.aliasnames.insert(pd.mangledname);
  965. if assigned(pinested) then
  966. begin
  967. { transfer all captured syms }
  968. capturesyms:=pinested.procdef.capturedsyms;
  969. if assigned(capturesyms) then
  970. begin
  971. for i:=0 to capturesyms.count-1 do
  972. begin
  973. captured:=pcapturedsyminfo(capturesyms[i]);
  974. pi.add_captured_sym(captured^.sym,captured^.fileinfo);
  975. dispose(captured);
  976. end;
  977. capturesyms.clear;
  978. end;
  979. { the original nested function now needs to capture only the capturer }
  980. pinested.procdef.add_captured_sym(capturer,n.fileinfo);
  981. end
  982. { does this need to capture Self? }
  983. else if not foreachnodestatic(pm_postprocess,n,@find_self_sym,@selfinfo) then
  984. begin
  985. { is this a method of the current class? }
  986. if (n.resultdef.typ=procdef) and
  987. assigned(tprocdef(n.resultdef).struct) and
  988. not (po_staticmethod in tprocdef(n.resultdef).procoptions) and
  989. assigned(current_procinfo.procdef.struct) and
  990. def_is_related(current_procinfo.procdef.struct,tprocdef(n.resultdef).struct) then
  991. begin
  992. selfinfo.selfsym:=tsym(current_procinfo.procdef.parast.find('self'));
  993. if not assigned(selfinfo.selfsym) then
  994. internalerror(2022110601);
  995. end
  996. else
  997. { does this need some other local variable or parameter? }
  998. foreachnodestatic(pm_postprocess,n,@collect_syms_to_capture,@pd)
  999. end;
  1000. if assigned(selfinfo.selfsym) and not assigned(fieldsym) then
  1001. { this isn't a procdef that was captured into a field, so capture the
  1002. self }
  1003. pd.add_captured_sym(selfinfo.selfsym,n.fileinfo);
  1004. print_procinfo(pi);
  1005. if assigned(pinested) then
  1006. print_procinfo(pinested);
  1007. implintf.AddMapping(upcase(result.objrealname^+'.')+method_name_funcref_invoke_find,upcase(invokename));
  1008. capture_captured_syms(pd,owner,capturedef);
  1009. end;
  1010. function capturer_add_anonymous_proc(owner:tprocinfo;pd:tprocdef;out capturer:tsym):tobjectdef;
  1011. var
  1012. capturedef : tobjectdef;
  1013. implintf : TImplementedInterface;
  1014. invokename : tsymstr;
  1015. i : longint;
  1016. outerself,
  1017. selfsym,
  1018. sym : tsym;
  1019. info : pcapturedsyminfo;
  1020. pi : tprocinfo;
  1021. mapping : tsym_mapping;
  1022. invokedef,
  1023. parentdef,
  1024. curpd : tprocdef;
  1025. syms : tfpobjectlist;
  1026. begin
  1027. capturer:=nil;
  1028. result:=funcref_intf_for_proc(pd,fileinfo_to_suffix(pd.fileinfo));
  1029. if df_generic in pd.defoptions then
  1030. begin
  1031. if (po_anonymous in pd.procoptions) and
  1032. assigned(pd.capturedsyms) and
  1033. (pd.capturedsyms.count>0) then
  1034. begin
  1035. { only check whether the symbols can be captured, but don't
  1036. convert anything to avoid problems }
  1037. for i:=0 to pd.capturedsyms.count-1 do
  1038. begin
  1039. info:=pcapturedsyminfo(pd.capturedsyms[i]);
  1040. if not can_be_captured(info^.sym) then
  1041. MessagePos1(info^.fileinfo,sym_e_symbol_no_capture,info^.sym.realname)
  1042. end;
  1043. end;
  1044. exit;
  1045. end;
  1046. capturer:=get_or_create_capturer(owner.procdef);
  1047. if not (capturer.typ in [localvarsym,staticvarsym]) then
  1048. internalerror(2022010711);
  1049. capturedef:=tobjectdef(tabstractvarsym(capturer).vardef);
  1050. if not is_class(capturedef) then
  1051. internalerror(2022010712);
  1052. implintf:=find_implemented_interface(capturedef,result);
  1053. if assigned(implintf) then
  1054. begin
  1055. { this can only already be an implemented interface if a named procdef
  1056. was assigned to a function ref at an earlier point, an anonymous
  1057. function can be used only once }
  1058. if po_anonymous in pd.procoptions then
  1059. internalerror(2022010713);
  1060. exit;
  1061. end;
  1062. implintf:=capturedef.register_implemented_interface(result,true);
  1063. invokename:=method_name_funcref_invoke_decl+'__FPCINTERNAL__'+fileinfo_to_suffix(pd.fileinfo);
  1064. if po_anonymous in pd.procoptions then
  1065. begin
  1066. { turn the anonymous function into a method of the capturer }
  1067. pd.changeowner(capturedef.symtable);
  1068. pd.struct:=capturedef;
  1069. exclude(pd.procoptions,po_anonymous);
  1070. exclude(pd.procoptions,po_delphi_nested_cc);
  1071. exclude(pd.procoptions,po_staticmethod);
  1072. exclude(pd.procoptions,po_classmethod);
  1073. pd.was_anonymous:=true;
  1074. pd.procsym.ChangeOwnerAndName(capturedef.symtable,upcase(invokename));
  1075. pd.procsym.realname:=invokename;
  1076. pd.parast.symtablelevel:=normal_function_level;
  1077. pd.localst.symtablelevel:=normal_function_level;
  1078. { collect all hidden parameters and especially the self parameter (if any) }
  1079. selfsym:=nil;
  1080. syms:=tfpobjectlist.create(false);
  1081. for i:=0 to pd.parast.symlist.count-1 do
  1082. begin
  1083. sym:=tsym(pd.parast.symlist[i]);
  1084. if sym.typ<>paravarsym then
  1085. continue;
  1086. if vo_is_self in tparavarsym(sym).varoptions then
  1087. selfsym:=sym
  1088. else if vo_is_hidden_para in tparavarsym(sym).varoptions then
  1089. syms.add(sym);
  1090. end;
  1091. { get rid of the hidden parameters; they will be added again during
  1092. buildvmt of the capturer }
  1093. for i:=0 to syms.count-1 do
  1094. pd.parast.deletesym(tsym(syms[i]));
  1095. syms.free;
  1096. outerself:=nil;
  1097. { complain about all symbols that can't be captured and add the symbols
  1098. to this procdefs capturedsyms if it isn't a top level function }
  1099. if assigned(pd.capturedsyms) and (pd.capturedsyms.count>0) then
  1100. begin
  1101. for i:=0 to pd.capturedsyms.count-1 do
  1102. begin
  1103. info:=pcapturedsyminfo(pd.capturedsyms[i]);
  1104. if not can_be_captured(info^.sym) then
  1105. MessagePos1(info^.fileinfo,sym_e_symbol_no_capture,info^.sym.realname)
  1106. else if info^.sym=selfsym then
  1107. begin
  1108. { we need to replace the captured "dummy" self parameter
  1109. with the real self parameter symbol from the surrounding
  1110. method }
  1111. if not assigned(outerself) then
  1112. outerself:=tsym(owner.get_normal_proc.procdef.parast.find('self'));
  1113. if not assigned(outerself) then
  1114. internalerror(2022010905);
  1115. { the anonymous function can only be a direct child of the
  1116. owner }
  1117. pi:=owner.get_first_nestedproc;
  1118. while assigned(pi) do
  1119. begin
  1120. if pi.procdef=pd then
  1121. break;
  1122. pi:=tprocinfo(pi.next);
  1123. end;
  1124. if not assigned(pi) then
  1125. internalerror(2022010906);
  1126. mapping.oldsym:=selfsym;
  1127. mapping.newsym:=outerself;
  1128. { replace all uses of the captured Self by the new Self
  1129. parameter }
  1130. foreachnodestatic(pm_preprocess,tcgprocinfo(pi).code,@replace_self_sym,@mapping);
  1131. { update the captured symbol }
  1132. info^.sym:=outerself;
  1133. end
  1134. else if info^.sym.owner.defowner<>owner.procdef then
  1135. owner.procdef.add_captured_sym(info^.sym,info^.fileinfo);
  1136. end;
  1137. end;
  1138. { delete the original self parameter }
  1139. if assigned(selfsym) then
  1140. pd.parast.deletesym(selfsym);
  1141. { note: don't call insert_self_and_vmt_para here, as that is later on
  1142. done when building the VMT }
  1143. end
  1144. else
  1145. internalerror(2022022201);
  1146. implintf.AddMapping(upcase(result.objrealname^+'.')+method_name_funcref_invoke_find,upcase(invokename));
  1147. capture_captured_syms(pd,owner,capturedef);
  1148. end;
  1149. function load_capturer(capturer:tabstractvarsym):tnode;inline;
  1150. begin
  1151. result:=cloadnode.create(capturer,capturer.owner);
  1152. end;
  1153. function instantiate_capturer(capturer_sym:tabstractvarsym):tnode;
  1154. var
  1155. capturer_def : tobjectdef;
  1156. ctor : tprocsym;
  1157. begin
  1158. capturer_def:=tobjectdef(capturer_sym.vardef);
  1159. { Neither TInterfacedObject, nor TCapturer have a custom constructor }
  1160. ctor:=tprocsym(class_tobject.symtable.Find('CREATE'));
  1161. if not assigned(ctor) then
  1162. internalerror(2022010801);
  1163. { Insert "Capturer := TCapturer.Create()" as the first statement of the routine }
  1164. result:=cloadvmtaddrnode.create(ctypenode.create(capturer_def));
  1165. result:=ccallnode.create(nil,ctor,capturer_def.symtable,result,[],nil);
  1166. result:=cassignmentnode.create(load_capturer(capturer_sym),result);
  1167. end;
  1168. procedure initialize_captured_paras(pd:tprocdef;capturer:tabstractvarsym;var stmt:tstatementnode);
  1169. var
  1170. i : longint;
  1171. psym: tparavarsym;
  1172. n : tnode;
  1173. begin
  1174. for i:=0 to pd.paras.count-1 do
  1175. begin
  1176. psym:=tparavarsym(pd.paras[i]);
  1177. if not psym.is_captured then
  1178. continue;
  1179. {$ifdef DEBUG_CAPTURER}writeln(#9'initialize captured parameter ',psym.RealName);{$endif}
  1180. n:=cloadnode.create(psym,psym.owner);
  1181. if psym.capture_sym.owner.defowner<>capturer.vardef then
  1182. internalerror(2022010903);
  1183. if (vo_is_self in psym.varoptions) and not is_implicit_pointer_object_type(psym.vardef) then
  1184. n:=caddrnode.create(n);
  1185. n:=cassignmentnode.create(
  1186. csubscriptnode.create(psym.capture_sym,cloadnode.create(capturer,capturer.owner)),
  1187. n
  1188. );
  1189. addstatement(stmt,n);
  1190. end;
  1191. end;
  1192. procedure attach_outer_capturer(ctx:tprocinfo;capturer:tabstractvarsym;var stmt:tstatementnode);
  1193. var
  1194. alivefield,
  1195. selffield : tfieldvarsym;
  1196. outeralive,
  1197. outercapturer : tabstractvarsym;
  1198. alivenode,
  1199. selfnode : tnode;
  1200. begin
  1201. if not ctx.procdef.was_anonymous and
  1202. not (ctx.procdef.owner.symtabletype=localsymtable) then
  1203. exit;
  1204. selffield:=tfieldvarsym(tobjectdef(capturer.vardef).symtable.find(outer_self_field_name));
  1205. if not assigned(selffield) then
  1206. { we'll simply assume that we don't need the outer capturer }
  1207. exit;
  1208. alivefield:=tfieldvarsym(tobjectdef(capturer.vardef).symtable.find(outer_self_field_name+keepalive_suffix));
  1209. if not assigned(alivefield) then
  1210. internalerror(2022051701);
  1211. if ctx.procdef.was_anonymous then
  1212. begin
  1213. selfnode:=load_self_node;
  1214. alivenode:=selfnode.getcopy;
  1215. end
  1216. else
  1217. begin
  1218. outercapturer:=get_capturer(tprocdef(ctx.procdef.owner.defowner));
  1219. if not assigned(outercapturer) then
  1220. internalerror(2022011605);
  1221. selfnode:=cloadnode.create(outercapturer,outercapturer.owner);
  1222. outeralive:=get_capturer_alive(tprocdef(ctx.procdef.owner.defowner));
  1223. if not assigned(outeralive) then
  1224. internalerror(2022051706);
  1225. alivenode:=cloadnode.create(outeralive,outeralive.owner);
  1226. end;
  1227. addstatement(stmt,cassignmentnode.create(
  1228. csubscriptnode.create(
  1229. selffield,
  1230. cloadnode.create(
  1231. capturer,
  1232. capturer.owner
  1233. )
  1234. ),
  1235. selfnode));
  1236. addstatement(stmt,cassignmentnode.create(
  1237. csubscriptnode.create(
  1238. alivefield,
  1239. cloadnode.create(
  1240. capturer,
  1241. capturer.owner
  1242. )
  1243. ),
  1244. alivenode));
  1245. end;
  1246. procedure initialize_capturer(ctx:tprocinfo;var stmt:tstatementnode);
  1247. var
  1248. capturer_sym,
  1249. keepalive_sym : tabstractvarsym;
  1250. begin
  1251. if ctx.procdef.has_capturer then
  1252. begin
  1253. capturer_sym:=get_capturer(ctx.procdef);
  1254. {$ifdef DEBUG_CAPTURER}writeln('initialize_capturer @ ',ctx.procdef.procsym.RealName);{$endif}
  1255. addstatement(stmt,instantiate_capturer(capturer_sym));
  1256. attach_outer_capturer(ctx,capturer_sym,stmt);
  1257. initialize_captured_paras(ctx.procdef,capturer_sym,stmt);
  1258. keepalive_sym:=get_capturer_alive(ctx.procdef);
  1259. if not assigned(keepalive_sym) then
  1260. internalerror(2022010701);
  1261. addstatement(stmt,cassignmentnode.create(cloadnode.create(keepalive_sym,keepalive_sym.owner),load_capturer(capturer_sym)));
  1262. end;
  1263. end;
  1264. procedure postprocess_capturer(ctx: tprocinfo);
  1265. var
  1266. def: tobjectdef;
  1267. begin
  1268. if not ctx.procdef.has_capturer then
  1269. exit;
  1270. def:=tobjectdef(get_capturer(ctx.procdef).vardef);
  1271. {$ifdef DEBUG_CAPTURER}writeln('process capturer ',def.typesym.Name);{$endif}
  1272. { These two are delayed until this point because
  1273. ... we have been adding fields on-the-fly }
  1274. tabstractrecordsymtable(def.symtable).addalignmentpadding;
  1275. { ... we have been adding interfaces on-the-fly }
  1276. build_vmt(def);
  1277. end;
  1278. type
  1279. tconvert_arg=record
  1280. mappings:tfplist;
  1281. end;
  1282. pconvert_arg=^tconvert_arg;
  1283. tconvert_mapping=record
  1284. oldsym:tsym;
  1285. newsym:tsym;
  1286. selfnode:tnode;
  1287. end;
  1288. pconvert_mapping=^tconvert_mapping;
  1289. function convert_captured_sym(var n:tnode;arg:pointer):foreachnoderesult;
  1290. var
  1291. convertarg : pconvert_arg absolute arg;
  1292. mapping : pconvert_mapping;
  1293. i : longint;
  1294. old_filepos : tfileposinfo;
  1295. loadprocvar : boolean;
  1296. begin
  1297. result:=fen_true;
  1298. if n.nodetype<>loadn then
  1299. exit;
  1300. for i:=0 to convertarg^.mappings.count-1 do
  1301. begin
  1302. mapping:=convertarg^.mappings[i];
  1303. if tloadnode(n).symtableentry<>mapping^.oldsym then
  1304. continue;
  1305. old_filepos:=current_filepos;
  1306. current_filepos:=n.fileinfo;
  1307. loadprocvar:=nf_load_procvar in n.flags;
  1308. n.free;
  1309. n:=csubscriptnode.create(mapping^.newsym,mapping^.selfnode.getcopy);
  1310. if loadprocvar then
  1311. include(n.flags,nf_load_procvar);
  1312. if (mapping^.oldsym.typ=paravarsym) and
  1313. (vo_is_self in tparavarsym(mapping^.oldsym).varoptions) and
  1314. not is_implicit_pointer_object_type(tparavarsym(mapping^.oldsym).vardef) then
  1315. n:=cderefnode.create(n);
  1316. typecheckpass(n);
  1317. current_filepos:=old_filepos;
  1318. break;
  1319. end;
  1320. end;
  1321. procedure convert_captured_syms(pd:tprocdef;tree:tnode);
  1322. function self_tree_for_sym(selfsym:tsym;fieldsym:tsym):tnode;
  1323. var
  1324. fieldowner : tdef;
  1325. newsym : tsym;
  1326. begin
  1327. result:=cloadnode.create(selfsym,selfsym.owner);
  1328. fieldowner:=tdef(fieldsym.owner.defowner);
  1329. newsym:=selfsym;
  1330. while (tabstractvarsym(newsym).vardef<>fieldowner) do
  1331. begin
  1332. newsym:=tsym(tobjectdef(tabstractvarsym(newsym).vardef).symtable.find(outer_self_field_name));
  1333. if not assigned(newsym) then
  1334. internalerror(2022011101);
  1335. result:=csubscriptnode.create(newsym,result);
  1336. end;
  1337. end;
  1338. var
  1339. i,j : longint;
  1340. capturer : tobjectdef;
  1341. tocapture,
  1342. capturedsyms : tfplist;
  1343. convertarg : tconvert_arg;
  1344. mapping : pconvert_mapping;
  1345. invokepd : tprocdef;
  1346. selfsym,
  1347. sym : tsym;
  1348. info: pcapturedsyminfo;
  1349. begin
  1350. {$ifdef DEBUG_CAPTURER}writeln('Converting captured symbols of ',pd.procsym.name);{$endif}
  1351. convertarg.mappings:=tfplist.create;
  1352. capturedsyms:=tfplist.create;
  1353. if pd.was_anonymous and
  1354. assigned(pd.capturedsyms) and
  1355. (pd.capturedsyms.count>0) then
  1356. begin
  1357. {$ifdef DEBUG_CAPTURER}writeln('Converting symbols of converted anonymous function ',pd.procsym.name);{$endif}
  1358. { this is a converted anonymous function, so rework all symbols that
  1359. now belong to the new Self }
  1360. selfsym:=tsym(pd.parast.find('self'));
  1361. if not assigned(selfsym) then
  1362. internalerror(2022010809);
  1363. for i:=0 to pd.capturedsyms.count-1 do
  1364. begin
  1365. sym:=tsym(pcapturedsyminfo(pd.capturedsyms[i])^.sym);
  1366. if not can_be_captured(sym) then
  1367. continue;
  1368. {$ifdef DEBUG_CAPTURER}writeln('Replacing symbol ',sym.Name);{$endif}
  1369. new(mapping);
  1370. mapping^.oldsym:=sym;
  1371. mapping^.newsym:=tabstractnormalvarsym(sym).capture_sym;
  1372. if not assigned(mapping^.newsym) then
  1373. internalerror(2022010810);
  1374. mapping^.selfnode:=self_tree_for_sym(selfsym,mapping^.newsym);
  1375. convertarg.mappings.add(mapping);
  1376. capturedsyms.add(sym);
  1377. end;
  1378. end;
  1379. if (pd.parast.symtablelevel>normal_function_level) and
  1380. assigned(pd.capturedsyms) and
  1381. (pd.capturedsyms.count>0) then
  1382. begin
  1383. if pd.was_anonymous then
  1384. internalerror(2022081201);
  1385. {$ifdef DEBUG_CAPTURER}writeln('Converting symbols of nested function ',pd.procsym.name);{$endif}
  1386. { this is a nested function, so rework all symbols that are used from
  1387. a parent function, but that might have been captured }
  1388. for i:=0 to pd.capturedsyms.count-1 do
  1389. begin
  1390. sym:=tsym(pcapturedsyminfo(pd.capturedsyms[i])^.sym);
  1391. if not can_be_captured(sym) or not assigned(tabstractnormalvarsym(sym).capture_sym) then
  1392. continue;
  1393. {$ifdef DEBUG_CAPTURER}writeln('Replacing symbol ',sym.Name);{$endif}
  1394. new(mapping);
  1395. mapping^.oldsym:=sym;
  1396. mapping^.newsym:=tabstractnormalvarsym(sym).capture_sym;
  1397. capturer:=tobjectdef(mapping^.newsym.owner.defowner);
  1398. if not is_class(capturer) then
  1399. internalerror(2022012701);
  1400. if not (capturer.typesym.owner.symtabletype in [localsymtable,staticsymtable]) then
  1401. internalerror(2022012702);
  1402. selfsym:=tsym(capturer.typesym.owner.find(capturer_var_name));
  1403. if not assigned(selfsym) then
  1404. internalerror(2022012703);
  1405. mapping^.selfnode:=self_tree_for_sym(selfsym,mapping^.newsym);
  1406. convertarg.mappings.add(mapping);
  1407. capturedsyms.add(sym);
  1408. end;
  1409. end;
  1410. if pd.has_capturer then
  1411. begin
  1412. {$ifdef DEBUG_CAPTURER}writeln('Converting symbols of function ',pd.procsym.name,' with capturer');{$endif}
  1413. { this procedure has a capturer, so rework all symbols that are
  1414. captured in that capturer }
  1415. selfsym:=get_capturer(pd);
  1416. { only capture those symbols that weren't capture already by one of
  1417. the above if-clauses and thus are now listed in capturedsyms }
  1418. tocapture:=tfplist.create;
  1419. for i:=0 to pd.localst.symlist.count-1 do
  1420. begin
  1421. sym:=tsym(pd.localst.symlist[i]);
  1422. if sym.typ<>localvarsym then
  1423. continue;
  1424. if assigned(tabstractnormalvarsym(sym).capture_sym) then
  1425. if capturedsyms.indexof(sym)<0 then
  1426. tocapture.add(sym);
  1427. end;
  1428. for i:=0 to pd.parast.symlist.count-1 do
  1429. begin
  1430. sym:=tsym(pd.parast.symlist[i]);
  1431. if sym.typ<>paravarsym then
  1432. continue;
  1433. if assigned(tabstractnormalvarsym(sym).capture_sym) and
  1434. { no need to adjust accesses to the outermost Self inside the
  1435. outermost method }
  1436. not (vo_is_self in tabstractvarsym(sym).varoptions) then
  1437. if capturedsyms.indexof(sym)<0 then
  1438. tocapture.add(sym);
  1439. end;
  1440. for i:=0 to tocapture.count-1 do
  1441. begin
  1442. new(mapping);
  1443. mapping^.oldsym:=tsym(tocapture[i]);
  1444. {$ifdef DEBUG_CAPTURER}writeln('Replacing symbol ',mapping^.oldsym.Name);{$endif}
  1445. mapping^.newsym:=tabstractnormalvarsym(mapping^.oldsym).capture_sym;
  1446. if not assigned(mapping^.newsym) then
  1447. internalerror(2022010805);
  1448. mapping^.selfnode:=self_tree_for_sym(selfsym,mapping^.newsym);
  1449. convertarg.mappings.add(mapping);
  1450. end;
  1451. tocapture.free;
  1452. end;
  1453. { not required anymore }
  1454. capturedsyms.free;
  1455. foreachnodestatic(pm_postprocess,tree,@convert_captured_sym,@convertarg);
  1456. for i:=0 to convertarg.mappings.count-1 do
  1457. begin
  1458. mapping:=pconvert_mapping(convertarg.mappings[i]);
  1459. mapping^.selfnode.free;
  1460. dispose(mapping);
  1461. end;
  1462. convertarg.mappings.free;
  1463. end;
  1464. end.