procdefutil.pas 58 KB

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