2
0

ncgflw.pas 52 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276
  1. {
  2. Copyright (c) 1998-2002 by Florian Klaempfl
  3. Generate assembler for nodes that influence the flow which are
  4. the same for all (most?) processors
  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. unit ncgflw;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. globtype,
  23. aasmbase,aasmdata,node,nflw,
  24. pass_2,cgutils,ncgutil;
  25. type
  26. tcgwhilerepeatnode = class(twhilerepeatnode)
  27. usedregvars: tusedregvars;
  28. procedure pass_generate_code;override;
  29. procedure sync_regvars(checkusedregvars: boolean);
  30. end;
  31. tcgifnode = class(tifnode)
  32. procedure pass_generate_code;override;
  33. end;
  34. tcgfornode = class(tfornode)
  35. procedure pass_generate_code;override;
  36. end;
  37. tcgexitnode = class(texitnode)
  38. procedure pass_generate_code;override;
  39. end;
  40. tcgbreaknode = class(tbreaknode)
  41. procedure pass_generate_code;override;
  42. end;
  43. tcgcontinuenode = class(tcontinuenode)
  44. procedure pass_generate_code;override;
  45. end;
  46. tcggotonode = class(tgotonode)
  47. procedure pass_generate_code;override;
  48. end;
  49. tcglabelnode = class(tlabelnode)
  50. protected
  51. asmlabel : tasmlabel;
  52. public
  53. function getasmlabel : tasmlabel; virtual;
  54. procedure pass_generate_code;override;
  55. end;
  56. tcgraisenode = class(traisenode)
  57. end;
  58. { Utility class for exception handling state management that is used
  59. by tryexcept/tryfinally/on nodes (in a separate class so it can both
  60. be shared and overridden)
  61. Never instantiated. }
  62. tcgexceptionstatehandler = class
  63. type
  64. texceptiontemps=record
  65. jmpbuf,
  66. envbuf,
  67. reasonbuf : treference;
  68. end;
  69. texceptionstate = record
  70. exceptionlabel: TAsmLabel;
  71. oldflowcontrol,
  72. newflowcontrol: tflowcontrol;
  73. end;
  74. class procedure get_exception_temps(list:TAsmList;var t:texceptiontemps); virtual;
  75. class procedure unget_exception_temps(list:TAsmList;const t:texceptiontemps); virtual;
  76. class procedure new_exception(list:TAsmList;const t:texceptiontemps; out exceptstate: texceptionstate); virtual;
  77. class procedure emit_except_label(list: TAsmList; var exceptstate: texceptionstate); virtual;
  78. class procedure free_exception(list:TAsmList;const t:texceptiontemps;a:aint;endexceptlabel:tasmlabel;onlyfree:boolean); virtual;
  79. class procedure cleanupobjectstack; virtual;
  80. class procedure handle_nested_exception(list:TAsmList;const t:texceptiontemps;var entrystate: texceptionstate); virtual;
  81. end;
  82. tcgexceptionstatehandlerclass = class of tcgexceptionstatehandler;
  83. tcgtryexceptnode = class(ttryexceptnode)
  84. procedure pass_generate_code;override;
  85. end;
  86. tcgtryfinallynode = class(ttryfinallynode)
  87. procedure handle_safecall_exception;
  88. procedure pass_generate_code;override;
  89. end;
  90. tcgonnode = class(tonnode)
  91. procedure pass_generate_code;override;
  92. end;
  93. var
  94. cexceptionstatehandler: tcgexceptionstatehandlerclass;
  95. implementation
  96. uses
  97. cutils,
  98. verbose,globals,systems,constexp,
  99. symconst,symdef,symsym,symtable,symtype,aasmtai,aasmcpu,defutil,
  100. procinfo,cgbase,parabase,
  101. fmodule,
  102. cpubase,ncon,
  103. tgobj,paramgr,
  104. cgobj,hlcgobj,nutils
  105. ;
  106. {*****************************************************************************
  107. Second_While_RepeatN
  108. *****************************************************************************}
  109. procedure tcgwhilerepeatnode.sync_regvars(checkusedregvars: boolean);
  110. begin
  111. if (cs_opt_regvar in current_settings.optimizerswitches) and
  112. not(pi_has_label in current_procinfo.flags) then
  113. begin
  114. if checkusedregvars then
  115. begin
  116. usedregvars.intregvars.init;
  117. usedregvars.addrregvars.init;
  118. usedregvars.fpuregvars.init;
  119. usedregvars.mmregvars.init;
  120. { we have to synchronise both the regvars used in the loop }
  121. { and the ones in the while/until condition }
  122. get_used_regvars(self,usedregvars);
  123. gen_sync_regvars(current_asmdata.CurrAsmList,usedregvars);
  124. end
  125. else
  126. begin
  127. gen_sync_regvars(current_asmdata.CurrAsmList,usedregvars);
  128. usedregvars.intregvars.done;
  129. usedregvars.addrregvars.done;
  130. usedregvars.fpuregvars.done;
  131. usedregvars.mmregvars.done;
  132. end;
  133. end;
  134. end;
  135. procedure tcgwhilerepeatnode.pass_generate_code;
  136. var
  137. lcont,lbreak,lloop,
  138. oldclabel,oldblabel : tasmlabel;
  139. truelabel,falselabel : tasmlabel;
  140. oldflowcontrol : tflowcontrol;
  141. oldexecutionweight : longint;
  142. begin
  143. location_reset(location,LOC_VOID,OS_NO);
  144. current_asmdata.getjumplabel(lloop);
  145. current_asmdata.getjumplabel(lcont);
  146. current_asmdata.getjumplabel(lbreak);
  147. { arrange continue and breaklabels: }
  148. oldflowcontrol:=flowcontrol;
  149. oldclabel:=current_procinfo.CurrContinueLabel;
  150. oldblabel:=current_procinfo.CurrBreakLabel;
  151. include(flowcontrol,fc_inflowcontrol);
  152. exclude(flowcontrol,fc_unwind_loop);
  153. sync_regvars(true);
  154. {$ifdef OLDREGVARS}
  155. load_all_regvars(current_asmdata.CurrAsmList);
  156. {$endif OLDREGVARS}
  157. { handling code at the end as it is much more efficient, and makes
  158. while equal to repeat loop, only the end true/false is swapped (PFV) }
  159. if lnf_testatbegin in loopflags then
  160. hlcg.a_jmp_always(current_asmdata.CurrAsmList,lcont);
  161. if not(cs_opt_size in current_settings.optimizerswitches) then
  162. { align loop target }
  163. current_asmdata.CurrAsmList.concat(Tai_align.Create(current_settings.alignment.loopalign));
  164. hlcg.a_label(current_asmdata.CurrAsmList,lloop);
  165. current_procinfo.CurrContinueLabel:=lcont;
  166. current_procinfo.CurrBreakLabel:=lbreak;
  167. { calc register weight }
  168. oldexecutionweight:=cg.executionweight;
  169. cg.executionweight:=max(cg.executionweight,1)*8;
  170. if assigned(right) then
  171. secondpass(right);
  172. {$ifdef OLDREGVARS}
  173. load_all_regvars(current_asmdata.CurrAsmList);
  174. {$endif OLDREGVARS}
  175. hlcg.a_label(current_asmdata.CurrAsmList,lcont);
  176. if lnf_checknegate in loopflags then
  177. begin
  178. truelabel:=lbreak;
  179. falselabel:=lloop;
  180. end
  181. else
  182. begin
  183. truelabel:=lloop;
  184. falselabel:=lbreak;
  185. end;
  186. secondpass(left);
  187. hlcg.maketojumpboollabels(current_asmdata.CurrAsmList,left,truelabel,falselabel);
  188. cg.executionweight:=oldexecutionweight;
  189. hlcg.a_label(current_asmdata.CurrAsmList,lbreak);
  190. sync_regvars(false);
  191. current_procinfo.CurrContinueLabel:=oldclabel;
  192. current_procinfo.CurrBreakLabel:=oldblabel;
  193. { a break/continue in a while/repeat block can't be seen outside }
  194. flowcontrol:=oldflowcontrol+(flowcontrol-[fc_break,fc_continue,fc_inflowcontrol]);
  195. end;
  196. {*****************************************************************************
  197. tcgIFNODE
  198. *****************************************************************************}
  199. procedure tcgifnode.pass_generate_code;
  200. var
  201. hl : tasmlabel;
  202. oldflowcontrol: tflowcontrol;
  203. oldexecutionweight : longint;
  204. (*
  205. org_regvar_loaded_other,
  206. then_regvar_loaded_other,
  207. else_regvar_loaded_other : regvarother_booleanarray;
  208. org_regvar_loaded_int,
  209. then_regvar_loaded_int,
  210. else_regvar_loaded_int : Tsuperregisterset;
  211. org_list,
  212. then_list,
  213. else_list : TAsmList;
  214. *)
  215. begin
  216. location_reset(location,LOC_VOID,OS_NO);
  217. hl:=nil;
  218. oldflowcontrol := flowcontrol;
  219. include(flowcontrol,fc_inflowcontrol);
  220. secondpass(left);
  221. (*
  222. { save regvars loaded in the beginning so that we can restore them }
  223. { when processing the else-block }
  224. if cs_opt_regvar in current_settings.optimizerswitches then
  225. begin
  226. org_list := current_asmdata.CurrAsmList;
  227. current_asmdata.CurrAsmList := TAsmList.create;
  228. end;
  229. *)
  230. hlcg.maketojumpbool(current_asmdata.CurrAsmList,left);
  231. (*
  232. if cs_opt_regvar in current_settings.optimizerswitches then
  233. begin
  234. org_regvar_loaded_int := rg.regvar_loaded_int;
  235. org_regvar_loaded_other := rg.regvar_loaded_other;
  236. end;
  237. *)
  238. { determines registers weigths }
  239. oldexecutionweight:=cg.executionweight;
  240. cg.executionweight:=cg.executionweight div 2;
  241. if cg.executionweight<1 then
  242. cg.executionweight:=1;
  243. if assigned(right) then
  244. begin
  245. hlcg.a_label(current_asmdata.CurrAsmList,left.location.truelabel);
  246. secondpass(right);
  247. end;
  248. { save current asmlist (previous instructions + then-block) and }
  249. { loaded regvar state and create new clean ones }
  250. {
  251. if cs_opt_regvar in current_settings.optimizerswitches then
  252. begin
  253. then_regvar_loaded_int := rg.regvar_loaded_int;
  254. then_regvar_loaded_other := rg.regvar_loaded_other;
  255. rg.regvar_loaded_int := org_regvar_loaded_int;
  256. rg.regvar_loaded_other := org_regvar_loaded_other;
  257. then_list := current_asmdata.CurrAsmList;
  258. current_asmdata.CurrAsmList := TAsmList.create;
  259. end;
  260. }
  261. if assigned(t1) then
  262. begin
  263. if assigned(right) then
  264. begin
  265. current_asmdata.getjumplabel(hl);
  266. { do go back to if line !! }
  267. (*
  268. if not(cs_opt_regvar in current_settings.optimizerswitches) then
  269. *)
  270. current_filepos:=current_asmdata.CurrAsmList.getlasttaifilepos^
  271. (*
  272. else
  273. current_filepos:=then_list.getlasttaifilepos^
  274. *)
  275. ;
  276. hlcg.a_jmp_always(current_asmdata.CurrAsmList,hl);
  277. end;
  278. hlcg.a_label(current_asmdata.CurrAsmList,left.location.falselabel);
  279. secondpass(t1);
  280. (*
  281. { save current asmlist (previous instructions + else-block) }
  282. { and loaded regvar state and create a new clean list }
  283. if cs_opt_regvar in current_settings.optimizerswitches then
  284. begin
  285. { else_regvar_loaded_int := rg.regvar_loaded_int;
  286. else_regvar_loaded_other := rg.regvar_loaded_other;}
  287. else_list := current_asmdata.CurrAsmList;
  288. current_asmdata.CurrAsmList := TAsmList.create;
  289. end;
  290. *)
  291. if assigned(right) then
  292. hlcg.a_label(current_asmdata.CurrAsmList,hl);
  293. end
  294. else
  295. begin
  296. (*
  297. if cs_opt_regvar in current_settings.optimizerswitches then
  298. begin
  299. { else_regvar_loaded_int := rg.regvar_loaded_int;
  300. else_regvar_loaded_other := rg.regvar_loaded_other;}
  301. else_list := current_asmdata.CurrAsmList;
  302. current_asmdata.CurrAsmList := TAsmList.create;
  303. end;
  304. *)
  305. hlcg.a_label(current_asmdata.CurrAsmList,left.location.falselabel);
  306. end;
  307. if not(assigned(right)) then
  308. begin
  309. hlcg.a_label(current_asmdata.CurrAsmList,left.location.truelabel);
  310. end;
  311. (*
  312. if cs_opt_regvar in current_settings.optimizerswitches then
  313. begin
  314. { add loads of regvars at the end of the then- and else-blocks }
  315. { so that at the end of both blocks the same regvars are loaded }
  316. { no else block? }
  317. if not assigned(t1) then
  318. begin
  319. sync_regvars_int(org_list,then_list,org_regvar_loaded_int,then_regvar_loaded_int);
  320. sync_regvars_other(org_list,then_list,org_regvar_loaded_other,then_regvar_loaded_other);
  321. end
  322. { no then block? }
  323. else if not assigned(right) then
  324. begin
  325. sync_regvars_int(org_list,else_list,org_regvar_loaded_int,else_regvar_loaded_int);
  326. sync_regvars_other(org_list,else_list,org_regvar_loaded_other,else_regvar_loaded_other);
  327. end
  328. { both else and then blocks }
  329. else
  330. begin
  331. sync_regvars_int(then_list,else_list,then_regvar_loaded_int,else_regvar_loaded_int);
  332. sync_regvars_other(then_list,else_list,then_regvar_loaded_other,else_regvar_loaded_other);
  333. end;
  334. { add all lists together }
  335. org_list.concatlist(then_list);
  336. then_list.free;
  337. org_list.concatlist(else_list);
  338. else_list.free;
  339. org_list.concatlist(current_asmdata.CurrAsmList);
  340. current_asmdata.CurrAsmList.free;
  341. current_asmdata.CurrAsmList := org_list;
  342. end;
  343. *)
  344. cg.executionweight:=oldexecutionweight;
  345. flowcontrol := oldflowcontrol + (flowcontrol - [fc_inflowcontrol]);
  346. end;
  347. {*****************************************************************************
  348. SecondFor
  349. *****************************************************************************}
  350. procedure tcgfornode.pass_generate_code;
  351. begin
  352. { for nodes are converted in pass_1 in a while loop }
  353. internalerror(2015082501);
  354. end;
  355. {*****************************************************************************
  356. SecondExitN
  357. *****************************************************************************}
  358. procedure tcgexitnode.pass_generate_code;
  359. begin
  360. location_reset(location,LOC_VOID,OS_NO);
  361. include(flowcontrol,fc_exit);
  362. if assigned(left) then
  363. secondpass(left);
  364. if (fc_unwind_exit in flowcontrol) then
  365. hlcg.g_local_unwind(current_asmdata.CurrAsmList,current_procinfo.CurrExitLabel)
  366. else
  367. hlcg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrExitLabel);
  368. end;
  369. {*****************************************************************************
  370. SecondBreakN
  371. *****************************************************************************}
  372. procedure tcgbreaknode.pass_generate_code;
  373. begin
  374. location_reset(location,LOC_VOID,OS_NO);
  375. include(flowcontrol,fc_break);
  376. if current_procinfo.CurrBreakLabel<>nil then
  377. begin
  378. {$ifdef OLDREGVARS}
  379. load_all_regvars(current_asmdata.CurrAsmList);
  380. {$endif OLDREGVARS}
  381. if (fc_unwind_loop in flowcontrol) then
  382. hlcg.g_local_unwind(current_asmdata.CurrAsmList,current_procinfo.CurrBreakLabel)
  383. else
  384. hlcg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrBreakLabel)
  385. end
  386. else
  387. CGMessage(cg_e_break_not_allowed);
  388. end;
  389. {*****************************************************************************
  390. SecondContinueN
  391. *****************************************************************************}
  392. procedure tcgcontinuenode.pass_generate_code;
  393. begin
  394. location_reset(location,LOC_VOID,OS_NO);
  395. include(flowcontrol,fc_continue);
  396. if current_procinfo.CurrContinueLabel<>nil then
  397. begin
  398. {$ifdef OLDREGVARS}
  399. load_all_regvars(current_asmdata.CurrAsmList);
  400. {$endif OLDREGVARS}
  401. if (fc_unwind_loop in flowcontrol) then
  402. hlcg.g_local_unwind(current_asmdata.CurrAsmList,current_procinfo.CurrContinueLabel)
  403. else
  404. hlcg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrContinueLabel)
  405. end
  406. else
  407. CGMessage(cg_e_continue_not_allowed);
  408. end;
  409. {*****************************************************************************
  410. SecondGoto
  411. *****************************************************************************}
  412. procedure tcggotonode.pass_generate_code;
  413. begin
  414. location_reset(location,LOC_VOID,OS_NO);
  415. include(flowcontrol,fc_gotolabel);
  416. {$ifdef OLDREGVARS}
  417. load_all_regvars(current_asmdata.CurrAsmList);
  418. {$endif OLDREGVARS}
  419. hlcg.a_jmp_always(current_asmdata.CurrAsmList,tcglabelnode(labelnode).getasmlabel)
  420. end;
  421. {*****************************************************************************
  422. SecondLabel
  423. *****************************************************************************}
  424. function tcglabelnode.getasmlabel : tasmlabel;
  425. begin
  426. if not(assigned(asmlabel)) then
  427. { labsym is not set in inlined procedures, but since assembler }
  428. { routines can't be inlined, that shouldn't matter }
  429. if assigned(labsym) and
  430. labsym.nonlocal then
  431. current_asmdata.getglobaljumplabel(asmlabel)
  432. else
  433. current_asmdata.getjumplabel(asmlabel);
  434. result:=asmlabel
  435. end;
  436. procedure tcglabelnode.pass_generate_code;
  437. begin
  438. location_reset(location,LOC_VOID,OS_NO);
  439. include(flowcontrol,fc_gotolabel);
  440. {$ifdef OLDREGVARS}
  441. load_all_regvars(current_asmdata.CurrAsmList);
  442. {$endif OLDREGVARS}
  443. hlcg.a_label(current_asmdata.CurrAsmList,getasmlabel);
  444. { Write also extra label if this label was referenced from
  445. assembler block }
  446. if assigned(labsym) and
  447. assigned(labsym.asmblocklabel) then
  448. hlcg.a_label(current_asmdata.CurrAsmList,labsym.asmblocklabel);
  449. secondpass(left);
  450. end;
  451. {*****************************************************************************
  452. tcgexceptionstatehandler
  453. *****************************************************************************}
  454. { Allocate the buffers for exception management and setjmp environment.
  455. Return a pointer to these buffers, send them to the utility routine
  456. so they are registered, and then call setjmp.
  457. Then compare the result of setjmp with 0, and if not equal
  458. to zero, then jump to exceptlabel.
  459. Also store the result of setjmp to a temporary space by calling g_save_exception_reason
  460. It is to note that this routine may be called *after* the stackframe of a
  461. routine has been called, therefore on machines where the stack cannot
  462. be modified, all temps should be allocated on the heap instead of the
  463. stack. }
  464. class procedure tcgexceptionstatehandler.get_exception_temps(list:TAsmList;var t:texceptiontemps);
  465. begin
  466. tg.gethltemp(list,rec_exceptaddr,rec_exceptaddr.size,tt_persistent,t.envbuf);
  467. tg.gethltemp(list,rec_jmp_buf,rec_jmp_buf.size,tt_persistent,t.jmpbuf);
  468. tg.gethltemp(list,ossinttype,ossinttype.size,tt_persistent,t.reasonbuf);
  469. end;
  470. class procedure tcgexceptionstatehandler.unget_exception_temps(list:TAsmList;const t:texceptiontemps);
  471. begin
  472. tg.Ungettemp(list,t.jmpbuf);
  473. tg.ungettemp(list,t.envbuf);
  474. tg.ungettemp(list,t.reasonbuf);
  475. end;
  476. class procedure tcgexceptionstatehandler.new_exception(list:TAsmList;const t:texceptiontemps; out exceptstate: texceptionstate);
  477. var
  478. paraloc1, paraloc2, paraloc3, pushexceptres, setjmpres: tcgpara;
  479. pd: tprocdef;
  480. tmpresloc: tlocation;
  481. begin
  482. current_asmdata.getjumplabel(exceptstate.exceptionlabel);
  483. exceptstate.oldflowcontrol:=flowcontrol;
  484. paraloc1.init;
  485. paraloc2.init;
  486. paraloc3.init;
  487. { fpc_pushexceptaddr(exceptionframetype, setjmp_buffer, exception_address_chain_entry) }
  488. pd:=search_system_proc('fpc_pushexceptaddr');
  489. paramanager.getintparaloc(current_asmdata.CurrAsmList,pd,1,paraloc1);
  490. paramanager.getintparaloc(current_asmdata.CurrAsmList,pd,2,paraloc2);
  491. paramanager.getintparaloc(current_asmdata.CurrAsmList,pd,3,paraloc3);
  492. if pd.is_pushleftright then
  493. begin
  494. { type of exceptionframe }
  495. hlcg.a_load_const_cgpara(list,paraloc1.def,1,paraloc1);
  496. { setjmp buffer }
  497. hlcg.a_loadaddr_ref_cgpara(list,rec_jmp_buf,t.jmpbuf,paraloc2);
  498. { exception address chain entry }
  499. hlcg.a_loadaddr_ref_cgpara(list,rec_exceptaddr,t.envbuf,paraloc3);
  500. end
  501. else
  502. begin
  503. hlcg.a_loadaddr_ref_cgpara(list,rec_exceptaddr,t.envbuf,paraloc3);
  504. hlcg.a_loadaddr_ref_cgpara(list,rec_jmp_buf,t.jmpbuf,paraloc2);
  505. hlcg.a_load_const_cgpara(list,paraloc1.def,1,paraloc1);
  506. end;
  507. paramanager.freecgpara(list,paraloc3);
  508. paramanager.freecgpara(list,paraloc2);
  509. paramanager.freecgpara(list,paraloc1);
  510. { perform the fpc_pushexceptaddr call }
  511. pushexceptres:=hlcg.g_call_system_proc(list,pd,[@paraloc1,@paraloc2,@paraloc3],nil);
  512. paraloc1.done;
  513. paraloc2.done;
  514. paraloc3.done;
  515. { get the result }
  516. location_reset(tmpresloc,LOC_REGISTER,def_cgsize(pushexceptres.def));
  517. tmpresloc.register:=hlcg.getaddressregister(list,pushexceptres.def);
  518. hlcg.gen_load_cgpara_loc(list,pushexceptres.def,pushexceptres,tmpresloc,true);
  519. pushexceptres.resetiftemp;
  520. { fpc_setjmp(result_of_pushexceptaddr_call) }
  521. pd:=search_system_proc('fpc_setjmp');
  522. paramanager.getintparaloc(current_asmdata.CurrAsmList,pd,1,paraloc1);
  523. hlcg.a_load_reg_cgpara(list,pushexceptres.def,tmpresloc.register,paraloc1);
  524. paramanager.freecgpara(list,paraloc1);
  525. { perform the fpc_setjmp call }
  526. setjmpres:=hlcg.g_call_system_proc(list,pd,[@paraloc1],nil);
  527. paraloc1.done;
  528. location_reset(tmpresloc,LOC_REGISTER,def_cgsize(setjmpres.def));
  529. tmpresloc.register:=hlcg.getintregister(list,setjmpres.def);
  530. hlcg.gen_load_cgpara_loc(list,setjmpres.def,setjmpres,tmpresloc,true);
  531. hlcg.g_exception_reason_save(list,setjmpres.def,ossinttype,tmpresloc.register,t.reasonbuf);
  532. { if we get 0 here in the function result register, it means that we
  533. longjmp'd back here }
  534. hlcg.a_cmp_const_reg_label(list,setjmpres.def,OC_NE,0,tmpresloc.register,exceptstate.exceptionlabel);
  535. setjmpres.resetiftemp;
  536. flowcontrol:=[fc_inflowcontrol,fc_catching_exceptions];
  537. end;
  538. class procedure tcgexceptionstatehandler.emit_except_label(list: TAsmList; var exceptstate: texceptionstate);
  539. begin
  540. hlcg.a_label(list,exceptstate.exceptionlabel);
  541. exceptstate.newflowcontrol:=flowcontrol;
  542. flowcontrol:=exceptstate.oldflowcontrol;
  543. end;
  544. class procedure tcgexceptionstatehandler.free_exception(list:TAsmList;const t:texceptiontemps;a:aint;endexceptlabel:tasmlabel;onlyfree:boolean);
  545. var
  546. reasonreg: tregister;
  547. begin
  548. hlcg.g_call_system_proc(list,'fpc_popaddrstack',[],nil);
  549. if not onlyfree then
  550. begin
  551. reasonreg:=hlcg.getintregister(list,osuinttype);
  552. hlcg.g_exception_reason_load(list,osuinttype,osuinttype,t.reasonbuf,reasonreg);
  553. hlcg.a_cmp_const_reg_label(list,osuinttype,OC_EQ,a,reasonreg,endexceptlabel);
  554. end;
  555. end;
  556. { does the necessary things to clean up the object stack }
  557. { in the except block }
  558. class procedure tcgexceptionstatehandler.cleanupobjectstack;
  559. begin
  560. hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_doneexception',[],nil);
  561. end;
  562. { generates code to be executed when another exeception is raised while
  563. control is inside except block }
  564. class procedure tcgexceptionstatehandler.handle_nested_exception(list:TAsmList;const t:texceptiontemps;var entrystate: texceptionstate);
  565. var
  566. exitlabel: tasmlabel;
  567. begin
  568. { don't generate line info for internal cleanup }
  569. list.concat(tai_marker.create(mark_NoLineInfoStart));
  570. current_asmdata.getjumplabel(exitlabel);
  571. emit_except_label(current_asmdata.CurrAsmList,entrystate);
  572. free_exception(list,t,0,exitlabel,false);
  573. { we don't need to save/restore registers here because reraise never }
  574. { returns }
  575. hlcg.g_call_system_proc(list,'fpc_raise_nested',[],nil);
  576. hlcg.a_label(list,exitlabel);
  577. cleanupobjectstack;
  578. end;
  579. {*****************************************************************************
  580. SecondTryExcept
  581. *****************************************************************************}
  582. var
  583. endexceptlabel : tasmlabel;
  584. procedure tcgtryexceptnode.pass_generate_code;
  585. var
  586. oldendexceptlabel,
  587. lastonlabel,
  588. exitexceptlabel,
  589. continueexceptlabel,
  590. breakexceptlabel,
  591. exittrylabel,
  592. continuetrylabel,
  593. breaktrylabel,
  594. oldCurrExitLabel,
  595. oldContinueLabel,
  596. oldBreakLabel : tasmlabel;
  597. destroytemps,
  598. excepttemps : tcgexceptionstatehandler.texceptiontemps;
  599. trystate,doobjectdestroyandreraisestate: tcgexceptionstatehandler.texceptionstate;
  600. label
  601. errorexit;
  602. begin
  603. location_reset(location,LOC_VOID,OS_NO);
  604. continuetrylabel:=nil;
  605. breaktrylabel:=nil;
  606. continueexceptlabel:=nil;
  607. breakexceptlabel:=nil;
  608. doobjectdestroyandreraisestate:=Default(tcgexceptionstatehandler.texceptionstate);
  609. { this can be called recursivly }
  610. oldBreakLabel:=nil;
  611. oldContinueLabel:=nil;
  612. oldendexceptlabel:=endexceptlabel;
  613. { save the old labels for control flow statements }
  614. oldCurrExitLabel:=current_procinfo.CurrExitLabel;
  615. if assigned(current_procinfo.CurrBreakLabel) then
  616. begin
  617. oldContinueLabel:=current_procinfo.CurrContinueLabel;
  618. oldBreakLabel:=current_procinfo.CurrBreakLabel;
  619. end;
  620. { get new labels for the control flow statements }
  621. current_asmdata.getjumplabel(exittrylabel);
  622. current_asmdata.getjumplabel(exitexceptlabel);
  623. if assigned(current_procinfo.CurrBreakLabel) then
  624. begin
  625. current_asmdata.getjumplabel(breaktrylabel);
  626. current_asmdata.getjumplabel(continuetrylabel);
  627. current_asmdata.getjumplabel(breakexceptlabel);
  628. current_asmdata.getjumplabel(continueexceptlabel);
  629. end;
  630. current_asmdata.getjumplabel(endexceptlabel);
  631. current_asmdata.getjumplabel(lastonlabel);
  632. cexceptionstatehandler.get_exception_temps(current_asmdata.CurrAsmList,excepttemps);
  633. cexceptionstatehandler.new_exception(current_asmdata.CurrAsmList,excepttemps,trystate);
  634. { try block }
  635. { set control flow labels for the try block }
  636. current_procinfo.CurrExitLabel:=exittrylabel;
  637. if assigned(oldBreakLabel) then
  638. begin
  639. current_procinfo.CurrContinueLabel:=continuetrylabel;
  640. current_procinfo.CurrBreakLabel:=breaktrylabel;
  641. end;
  642. secondpass(left);
  643. if codegenerror then
  644. goto errorexit;
  645. { don't generate line info for internal cleanup }
  646. current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoStart));
  647. cexceptionstatehandler.emit_except_label(current_asmdata.CurrAsmList,trystate);
  648. cexceptionstatehandler.free_exception(current_asmdata.CurrAsmList, excepttemps, 0, endexceptlabel, false);
  649. { end cleanup }
  650. current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd));
  651. { set control flow labels for the except block }
  652. { and the on statements }
  653. current_procinfo.CurrExitLabel:=exitexceptlabel;
  654. if assigned(oldBreakLabel) then
  655. begin
  656. current_procinfo.CurrContinueLabel:=continueexceptlabel;
  657. current_procinfo.CurrBreakLabel:=breakexceptlabel;
  658. end;
  659. flowcontrol:=[fc_inflowcontrol];
  660. { on statements }
  661. if assigned(right) then
  662. secondpass(right);
  663. { don't generate line info for internal cleanup }
  664. current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoStart));
  665. hlcg.a_label(current_asmdata.CurrAsmList,lastonlabel);
  666. { default handling except handling }
  667. if assigned(t1) then
  668. begin
  669. { FPC_CATCHES with 'default handler' flag (=-1) need no longer be called,
  670. it doesn't change any state and its return value is ignored (Sergei)
  671. }
  672. { the destruction of the exception object must be also }
  673. { guarded by an exception frame, but it can be omitted }
  674. { if there's no user code in 'except' block }
  675. if not (has_no_code(t1)) then
  676. begin
  677. cexceptionstatehandler.get_exception_temps(current_asmdata.CurrAsmList,destroytemps);
  678. cexceptionstatehandler.new_exception(current_asmdata.CurrAsmList,destroytemps,doobjectdestroyandreraisestate);
  679. { the flowcontrol from the default except-block must be merged
  680. with the flowcontrol flags potentially set by the
  681. on-statements handled above (secondpass(right)), as they are
  682. at the same program level }
  683. flowcontrol:=
  684. flowcontrol+
  685. doobjectdestroyandreraisestate.oldflowcontrol;
  686. { except block needs line info }
  687. current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd));
  688. secondpass(t1);
  689. cexceptionstatehandler.handle_nested_exception(current_asmdata.CurrAsmList,destroytemps,doobjectdestroyandreraisestate);
  690. cexceptionstatehandler.unget_exception_temps(current_asmdata.CurrAsmList,destroytemps);
  691. hlcg.a_jmp_always(current_asmdata.CurrAsmList,endexceptlabel);
  692. end
  693. else
  694. begin
  695. doobjectdestroyandreraisestate.newflowcontrol:=flowcontrol;
  696. cexceptionstatehandler.cleanupobjectstack;
  697. hlcg.a_jmp_always(current_asmdata.CurrAsmList,endexceptlabel);
  698. end;
  699. end
  700. else
  701. begin
  702. hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_reraise',[],nil);
  703. doobjectdestroyandreraisestate.newflowcontrol:=flowcontrol;
  704. end;
  705. if fc_exit in doobjectdestroyandreraisestate.newflowcontrol then
  706. begin
  707. { do some magic for exit in the try block }
  708. hlcg.a_label(current_asmdata.CurrAsmList,exitexceptlabel);
  709. { we must also destroy the address frame which guards }
  710. { exception object }
  711. hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_popaddrstack',[],nil);
  712. hlcg.g_exception_reason_discard(current_asmdata.CurrAsmList,osuinttype,excepttemps.reasonbuf);
  713. cexceptionstatehandler.cleanupobjectstack;
  714. hlcg.a_jmp_always(current_asmdata.CurrAsmList,oldCurrExitLabel);
  715. end;
  716. if fc_break in doobjectdestroyandreraisestate.newflowcontrol then
  717. begin
  718. hlcg.a_label(current_asmdata.CurrAsmList,breakexceptlabel);
  719. { we must also destroy the address frame which guards }
  720. { exception object }
  721. hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_popaddrstack',[],nil);
  722. hlcg.g_exception_reason_discard(current_asmdata.CurrAsmList,osuinttype,excepttemps.reasonbuf);
  723. cexceptionstatehandler.cleanupobjectstack;
  724. hlcg.a_jmp_always(current_asmdata.CurrAsmList,oldBreakLabel);
  725. end;
  726. if fc_continue in doobjectdestroyandreraisestate.newflowcontrol then
  727. begin
  728. hlcg.a_label(current_asmdata.CurrAsmList,continueexceptlabel);
  729. { we must also destroy the address frame which guards }
  730. { exception object }
  731. hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_popaddrstack',[],nil);
  732. hlcg.g_exception_reason_discard(current_asmdata.CurrAsmList,osuinttype,excepttemps.reasonbuf);
  733. cexceptionstatehandler.cleanupobjectstack;
  734. hlcg.a_jmp_always(current_asmdata.CurrAsmList,oldContinueLabel);
  735. end;
  736. if fc_exit in trystate.newflowcontrol then
  737. begin
  738. { do some magic for exit in the try block }
  739. hlcg.a_label(current_asmdata.CurrAsmList,exittrylabel);
  740. hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_popaddrstack',[],nil);
  741. hlcg.g_exception_reason_discard(current_asmdata.CurrAsmList,osuinttype,excepttemps.reasonbuf);
  742. hlcg.a_jmp_always(current_asmdata.CurrAsmList,oldCurrExitLabel);
  743. end;
  744. if fc_break in trystate.newflowcontrol then
  745. begin
  746. hlcg.a_label(current_asmdata.CurrAsmList,breaktrylabel);
  747. hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_popaddrstack',[],nil);
  748. hlcg.g_exception_reason_discard(current_asmdata.CurrAsmList,osuinttype,excepttemps.reasonbuf);
  749. hlcg.a_jmp_always(current_asmdata.CurrAsmList,oldBreakLabel);
  750. end;
  751. if fc_continue in trystate.newflowcontrol then
  752. begin
  753. hlcg.a_label(current_asmdata.CurrAsmList,continuetrylabel);
  754. hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_popaddrstack',[],nil);
  755. hlcg.g_exception_reason_discard(current_asmdata.CurrAsmList,osuinttype,excepttemps.reasonbuf);
  756. hlcg.a_jmp_always(current_asmdata.CurrAsmList,oldContinueLabel);
  757. end;
  758. cexceptionstatehandler.unget_exception_temps(current_asmdata.CurrAsmList,excepttemps);
  759. hlcg.a_label(current_asmdata.CurrAsmList,endexceptlabel);
  760. { end cleanup }
  761. current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd));
  762. errorexit:
  763. { restore all saved labels }
  764. endexceptlabel:=oldendexceptlabel;
  765. { restore the control flow labels }
  766. current_procinfo.CurrExitLabel:=oldCurrExitLabel;
  767. if assigned(oldBreakLabel) then
  768. begin
  769. current_procinfo.CurrContinueLabel:=oldContinueLabel;
  770. current_procinfo.CurrBreakLabel:=oldBreakLabel;
  771. end;
  772. { return all used control flow statements }
  773. flowcontrol:=trystate.oldflowcontrol+(doobjectdestroyandreraisestate.newflowcontrol +
  774. trystate.newflowcontrol - [fc_inflowcontrol,fc_catching_exceptions]);
  775. end;
  776. procedure tcgonnode.pass_generate_code;
  777. var
  778. nextonlabel,
  779. exitonlabel,
  780. continueonlabel,
  781. breakonlabel,
  782. oldCurrExitLabel,
  783. oldContinueLabel,
  784. oldBreakLabel : tasmlabel;
  785. doobjectdestroyandreraisestate: tcgexceptionstatehandler.texceptionstate;
  786. excepttemps : tcgexceptionstatehandler.texceptiontemps;
  787. href2: treference;
  788. paraloc1 : tcgpara;
  789. exceptvarsym : tlocalvarsym;
  790. pd : tprocdef;
  791. fpc_catches_res: TCGPara;
  792. fpc_catches_resloc: tlocation;
  793. otherunit,
  794. indirect : boolean;
  795. begin
  796. paraloc1.init;
  797. location_reset(location,LOC_VOID,OS_NO);
  798. oldCurrExitLabel:=nil;
  799. continueonlabel:=nil;
  800. breakonlabel:=nil;
  801. exitonlabel:=nil;
  802. current_asmdata.getjumplabel(nextonlabel);
  803. otherunit:=findunitsymtable(excepttype.owner).moduleid<>findunitsymtable(current_procinfo.procdef.owner).moduleid;
  804. indirect:=(tf_supports_packages in target_info.flags) and
  805. (target_info.system in systems_indirect_var_imports) and
  806. (cs_imported_data in current_settings.localswitches) and
  807. otherunit;
  808. { send the vmt parameter }
  809. pd:=search_system_proc('fpc_catches');
  810. reference_reset_symbol(href2,current_asmdata.RefAsmSymbol(excepttype.vmt_mangledname,AT_DATA,indirect),0,sizeof(pint),[]);
  811. if otherunit then
  812. current_module.add_extern_asmsym(excepttype.vmt_mangledname,AB_EXTERNAL,AT_DATA);
  813. paramanager.getintparaloc(current_asmdata.CurrAsmList,pd,1,paraloc1);
  814. hlcg.a_loadaddr_ref_cgpara(current_asmdata.CurrAsmList,excepttype.vmt_def,href2,paraloc1);
  815. paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc1);
  816. fpc_catches_res:=hlcg.g_call_system_proc(current_asmdata.CurrAsmList,pd,[@paraloc1],nil);
  817. location_reset(fpc_catches_resloc,LOC_REGISTER,def_cgsize(fpc_catches_res.def));
  818. fpc_catches_resloc.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,fpc_catches_res.def);
  819. hlcg.gen_load_cgpara_loc(current_asmdata.CurrAsmList,fpc_catches_res.def,fpc_catches_res,fpc_catches_resloc,true);
  820. { is it this catch? No. go to next onlabel }
  821. hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,fpc_catches_res.def,OC_EQ,0,fpc_catches_resloc.register,nextonlabel);
  822. { Retrieve exception variable }
  823. if assigned(excepTSymtable) then
  824. exceptvarsym:=tlocalvarsym(excepTSymtable.SymList[0])
  825. else
  826. internalerror(2011020401);
  827. if assigned(exceptvarsym) then
  828. begin
  829. location_reset_ref(exceptvarsym.localloc,LOC_REFERENCE,def_cgsize(voidpointertype),voidpointertype.alignment,[]);
  830. tg.GetLocal(current_asmdata.CurrAsmList,exceptvarsym.vardef.size,exceptvarsym.vardef,exceptvarsym.localloc.reference);
  831. hlcg.a_load_reg_ref(current_asmdata.CurrAsmList,fpc_catches_res.def,exceptvarsym.vardef,fpc_catches_resloc.register,exceptvarsym.localloc.reference);
  832. end;
  833. { in the case that another exception is risen
  834. we've to destroy the old one:
  835. call setjmp, and jump to finally label on non-zero result }
  836. cexceptionstatehandler.get_exception_temps(current_asmdata.CurrAsmList,excepttemps);
  837. cexceptionstatehandler.new_exception(current_asmdata.CurrAsmList,excepttemps,doobjectdestroyandreraisestate);
  838. oldBreakLabel:=nil;
  839. oldContinueLabel:=nil;
  840. if assigned(right) then
  841. begin
  842. oldCurrExitLabel:=current_procinfo.CurrExitLabel;
  843. current_asmdata.getjumplabel(exitonlabel);
  844. current_procinfo.CurrExitLabel:=exitonlabel;
  845. if assigned(current_procinfo.CurrBreakLabel) then
  846. begin
  847. oldContinueLabel:=current_procinfo.CurrContinueLabel;
  848. oldBreakLabel:=current_procinfo.CurrBreakLabel;
  849. current_asmdata.getjumplabel(breakonlabel);
  850. current_asmdata.getjumplabel(continueonlabel);
  851. current_procinfo.CurrContinueLabel:=continueonlabel;
  852. current_procinfo.CurrBreakLabel:=breakonlabel;
  853. end;
  854. secondpass(right);
  855. end;
  856. cexceptionstatehandler.handle_nested_exception(current_asmdata.CurrAsmList,excepttemps,doobjectdestroyandreraisestate);
  857. { clear some stuff }
  858. if assigned(exceptvarsym) then
  859. begin
  860. tg.UngetLocal(current_asmdata.CurrAsmList,exceptvarsym.localloc.reference);
  861. exceptvarsym.localloc.loc:=LOC_INVALID;
  862. end;
  863. hlcg.a_jmp_always(current_asmdata.CurrAsmList,endexceptlabel);
  864. if assigned(right) then
  865. begin
  866. { special handling for control flow instructions }
  867. if fc_exit in doobjectdestroyandreraisestate.newflowcontrol then
  868. begin
  869. { the address and object pop does secondtryexcept }
  870. hlcg.a_label(current_asmdata.CurrAsmList,exitonlabel);
  871. hlcg.a_jmp_always(current_asmdata.CurrAsmList,oldCurrExitLabel);
  872. end;
  873. if fc_break in doobjectdestroyandreraisestate.newflowcontrol then
  874. begin
  875. { the address and object pop does secondtryexcept }
  876. hlcg.a_label(current_asmdata.CurrAsmList,breakonlabel);
  877. hlcg.a_jmp_always(current_asmdata.CurrAsmList,oldBreakLabel);
  878. end;
  879. if fc_continue in doobjectdestroyandreraisestate.newflowcontrol then
  880. begin
  881. { the address and object pop does secondtryexcept }
  882. hlcg.a_label(current_asmdata.CurrAsmList,continueonlabel);
  883. hlcg.a_jmp_always(current_asmdata.CurrAsmList,oldContinueLabel);
  884. end;
  885. current_procinfo.CurrExitLabel:=oldCurrExitLabel;
  886. if assigned(oldBreakLabel) then
  887. begin
  888. current_procinfo.CurrContinueLabel:=oldContinueLabel;
  889. current_procinfo.CurrBreakLabel:=oldBreakLabel;
  890. end;
  891. end;
  892. cexceptionstatehandler.unget_exception_temps(current_asmdata.CurrAsmList,excepttemps);
  893. hlcg.a_label(current_asmdata.CurrAsmList,nextonlabel);
  894. flowcontrol:=doobjectdestroyandreraisestate.oldflowcontrol+(doobjectdestroyandreraisestate.newflowcontrol-[fc_inflowcontrol,fc_catching_exceptions]);
  895. paraloc1.done;
  896. current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd));
  897. { next on node }
  898. if assigned(left) then
  899. secondpass(left);
  900. end;
  901. {*****************************************************************************
  902. SecondTryFinally
  903. *****************************************************************************}
  904. procedure tcgtryfinallynode.handle_safecall_exception;
  905. var
  906. cgpara: tcgpara;
  907. selfsym: tparavarsym;
  908. pd: tprocdef;
  909. begin
  910. { call fpc_safecallhandler, passing self for methods of classes,
  911. nil otherwise. }
  912. pd:=search_system_proc('fpc_safecallhandler');
  913. cgpara.init;
  914. paramanager.getintparaloc(current_asmdata.CurrAsmList,pd,1,cgpara);
  915. if is_class(current_procinfo.procdef.struct) then
  916. begin
  917. selfsym:=tparavarsym(current_procinfo.procdef.parast.Find('self'));
  918. if (selfsym=nil) or (selfsym.typ<>paravarsym) then
  919. InternalError(2011123101);
  920. cg.a_load_loc_cgpara(current_asmdata.CurrAsmList,selfsym.localloc,cgpara);
  921. end
  922. else
  923. cg.a_load_const_cgpara(current_asmdata.CurrAsmList,OS_ADDR,0,cgpara);
  924. paramanager.freecgpara(current_asmdata.CurrAsmList,cgpara);
  925. cgpara.done;
  926. cg.g_call(current_asmdata.CurrAsmList,'FPC_SAFECALLHANDLER');
  927. cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,NR_FUNCTION_RESULT_REG, NR_FUNCTION_RETURN_REG);
  928. end;
  929. procedure tcgtryfinallynode.pass_generate_code;
  930. var
  931. endfinallylabel,
  932. exitfinallylabel,
  933. continuefinallylabel,
  934. breakfinallylabel,
  935. oldCurrExitLabel,
  936. oldContinueLabel,
  937. oldBreakLabel : tasmlabel;
  938. finallyexceptionstate: tcgexceptionstatehandler.texceptionstate;
  939. prefinallyflowcontrol : tflowcontrol;
  940. excepttemps : tcgexceptionstatehandler.texceptiontemps;
  941. reasonreg : tregister;
  942. begin
  943. location_reset(location,LOC_VOID,OS_NO);
  944. oldBreakLabel:=nil;
  945. oldContinueLabel:=nil;
  946. continuefinallylabel:=nil;
  947. breakfinallylabel:=nil;
  948. current_asmdata.getjumplabel(endfinallylabel);
  949. { call setjmp, and jump to finally label on non-zero result }
  950. cexceptionstatehandler.get_exception_temps(current_asmdata.CurrAsmList,excepttemps);
  951. cexceptionstatehandler.new_exception(current_asmdata.CurrAsmList,excepttemps,finallyexceptionstate);
  952. { the finally block must catch break, continue and exit }
  953. { statements }
  954. oldCurrExitLabel:=current_procinfo.CurrExitLabel;
  955. if implicitframe then
  956. exitfinallylabel:=finallyexceptionstate.exceptionlabel
  957. else
  958. current_asmdata.getjumplabel(exitfinallylabel);
  959. current_procinfo.CurrExitLabel:=exitfinallylabel;
  960. if assigned(current_procinfo.CurrBreakLabel) then
  961. begin
  962. oldContinueLabel:=current_procinfo.CurrContinueLabel;
  963. oldBreakLabel:=current_procinfo.CurrBreakLabel;
  964. if implicitframe then
  965. begin
  966. breakfinallylabel:=finallyexceptionstate.exceptionlabel;
  967. continuefinallylabel:=finallyexceptionstate.exceptionlabel;
  968. end
  969. else
  970. begin
  971. current_asmdata.getjumplabel(breakfinallylabel);
  972. current_asmdata.getjumplabel(continuefinallylabel);
  973. end;
  974. current_procinfo.CurrContinueLabel:=continuefinallylabel;
  975. current_procinfo.CurrBreakLabel:=breakfinallylabel;
  976. end;
  977. { try code }
  978. if assigned(left) then
  979. begin
  980. secondpass(left);
  981. if codegenerror then
  982. exit;
  983. end;
  984. { don't generate line info for internal cleanup }
  985. current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoStart));
  986. cexceptionstatehandler.emit_except_label(current_asmdata.CurrAsmList,finallyexceptionstate);
  987. { just free the frame information }
  988. cexceptionstatehandler.free_exception(current_asmdata.CurrAsmList,excepttemps,1,finallyexceptionstate.exceptionlabel,true);
  989. { end cleanup }
  990. current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd));
  991. { finally code (don't unconditionally set fc_inflowcontrol, since the
  992. finally code is unconditionally executed; we do have to filter out
  993. flags regarding break/contrinue/etc. because we have to give an
  994. error in case one of those is used in the finally-code }
  995. flowcontrol:=finallyexceptionstate.oldflowcontrol*[fc_inflowcontrol];
  996. secondpass(right);
  997. { goto is allowed if it stays inside the finally block,
  998. this is checked using the exception block number }
  999. if (flowcontrol-[fc_gotolabel])<>(finallyexceptionstate.oldflowcontrol*[fc_inflowcontrol]) then
  1000. CGMessage(cg_e_control_flow_outside_finally);
  1001. if codegenerror then
  1002. exit;
  1003. { don't generate line info for internal cleanup }
  1004. current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoStart));
  1005. { the value should now be in the exception handler }
  1006. reasonreg:=hlcg.getintregister(current_asmdata.CurrAsmList,osuinttype);
  1007. hlcg.g_exception_reason_load(current_asmdata.CurrAsmList,osuinttype,osuinttype,excepttemps.reasonbuf,reasonreg);
  1008. if implicitframe then
  1009. begin
  1010. hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,0,reasonreg,endfinallylabel);
  1011. { finally code only needed to be executed on exception (-> in
  1012. if-branch -> fc_inflowcontrol) }
  1013. flowcontrol:=[fc_inflowcontrol];
  1014. secondpass(t1);
  1015. if flowcontrol<>[fc_inflowcontrol] then
  1016. CGMessage(cg_e_control_flow_outside_finally);
  1017. if codegenerror then
  1018. exit;
  1019. if (tf_safecall_exceptions in target_info.flags) and
  1020. (current_procinfo.procdef.proccalloption=pocall_safecall) then
  1021. handle_safecall_exception
  1022. else
  1023. hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_reraise',[],nil);
  1024. end
  1025. else
  1026. begin
  1027. hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,0,reasonreg,endfinallylabel);
  1028. if fc_exit in finallyexceptionstate.newflowcontrol then
  1029. hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,2,reasonreg,oldCurrExitLabel);
  1030. if fc_break in finallyexceptionstate.newflowcontrol then
  1031. hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,3,reasonreg,oldBreakLabel);
  1032. if fc_continue in finallyexceptionstate.newflowcontrol then
  1033. hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,4,reasonreg,oldContinueLabel);
  1034. hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_reraise',[],nil);
  1035. { do some magic for exit,break,continue in the try block }
  1036. if fc_exit in finallyexceptionstate.newflowcontrol then
  1037. begin
  1038. hlcg.a_label(current_asmdata.CurrAsmList,exitfinallylabel);
  1039. hlcg.g_exception_reason_discard(current_asmdata.CurrAsmList,osuinttype,excepttemps.reasonbuf);
  1040. hlcg.g_exception_reason_save_const(current_asmdata.CurrAsmList,osuinttype,2,excepttemps.reasonbuf);
  1041. hlcg.a_jmp_always(current_asmdata.CurrAsmList,finallyexceptionstate.exceptionlabel);
  1042. end;
  1043. if fc_break in finallyexceptionstate.newflowcontrol then
  1044. begin
  1045. hlcg.a_label(current_asmdata.CurrAsmList,breakfinallylabel);
  1046. hlcg.g_exception_reason_discard(current_asmdata.CurrAsmList,osuinttype,excepttemps.reasonbuf);
  1047. hlcg.g_exception_reason_save_const(current_asmdata.CurrAsmList,osuinttype,3,excepttemps.reasonbuf);
  1048. hlcg.a_jmp_always(current_asmdata.CurrAsmList,finallyexceptionstate.exceptionlabel);
  1049. end;
  1050. if fc_continue in finallyexceptionstate.newflowcontrol then
  1051. begin
  1052. hlcg.a_label(current_asmdata.CurrAsmList,continuefinallylabel);
  1053. hlcg.g_exception_reason_discard(current_asmdata.CurrAsmList,osuinttype,excepttemps.reasonbuf);
  1054. hlcg.g_exception_reason_save_const(current_asmdata.CurrAsmList,osuinttype,4,excepttemps.reasonbuf);
  1055. hlcg.a_jmp_always(current_asmdata.CurrAsmList,finallyexceptionstate.exceptionlabel);
  1056. end;
  1057. end;
  1058. cexceptionstatehandler.unget_exception_temps(current_asmdata.CurrAsmList,excepttemps);
  1059. hlcg.a_label(current_asmdata.CurrAsmList,endfinallylabel);
  1060. { end cleanup }
  1061. current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd));
  1062. current_procinfo.CurrExitLabel:=oldCurrExitLabel;
  1063. if assigned(current_procinfo.CurrBreakLabel) then
  1064. begin
  1065. current_procinfo.CurrContinueLabel:=oldContinueLabel;
  1066. current_procinfo.CurrBreakLabel:=oldBreakLabel;
  1067. end;
  1068. flowcontrol:=finallyexceptionstate.oldflowcontrol+(finallyexceptionstate.newflowcontrol-[fc_inflowcontrol,fc_catching_exceptions]);
  1069. end;
  1070. begin
  1071. cwhilerepeatnode:=tcgwhilerepeatnode;
  1072. cifnode:=tcgifnode;
  1073. cfornode:=tcgfornode;
  1074. cexitnode:=tcgexitnode;
  1075. cbreaknode:=tcgbreaknode;
  1076. ccontinuenode:=tcgcontinuenode;
  1077. cgotonode:=tcggotonode;
  1078. clabelnode:=tcglabelnode;
  1079. craisenode:=tcgraisenode;
  1080. ctryexceptnode:=tcgtryexceptnode;
  1081. ctryfinallynode:=tcgtryfinallynode;
  1082. connode:=tcgonnode;
  1083. cexceptionstatehandler:=tcgexceptionstatehandler;
  1084. end.