procdefutil.pas 55 KB

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