procdefutil.pas 55 KB

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