procdefutil.pas 62 KB

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