procdefutil.pas 56 KB

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