procdefutil.pas 57 KB

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