ncgflw.pas 61 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Florian Klaempfl
  4. Generate assembler for nodes that influence the flow which are
  5. the same for all (most?) processors
  6. This program is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 2 of the License, or
  9. (at your option) any later version.
  10. This program is distributed in the hope that it will be useful,
  11. but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. GNU General Public License for more details.
  14. You should have received a copy of the GNU General Public License
  15. along with this program; if not, write to the Free Software
  16. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  17. ****************************************************************************
  18. }
  19. unit ncgflw;
  20. {$i fpcdefs.inc}
  21. interface
  22. uses
  23. node,nflw;
  24. type
  25. tcgwhilerepeatnode = class(twhilerepeatnode)
  26. procedure pass_2;override;
  27. end;
  28. tcgifnode = class(tifnode)
  29. procedure pass_2;override;
  30. end;
  31. tcgfornode = class(tfornode)
  32. procedure pass_2;override;
  33. end;
  34. tcgexitnode = class(texitnode)
  35. procedure pass_2;override;
  36. end;
  37. tcgbreaknode = class(tbreaknode)
  38. procedure pass_2;override;
  39. end;
  40. tcgcontinuenode = class(tcontinuenode)
  41. procedure pass_2;override;
  42. end;
  43. tcggotonode = class(tgotonode)
  44. procedure pass_2;override;
  45. end;
  46. tcglabelnode = class(tlabelnode)
  47. procedure pass_2;override;
  48. end;
  49. tcgraisenode = class(traisenode)
  50. procedure pass_2;override;
  51. end;
  52. tcgtryexceptnode = class(ttryexceptnode)
  53. procedure pass_2;override;
  54. end;
  55. tcgtryfinallynode = class(ttryfinallynode)
  56. procedure pass_2;override;
  57. end;
  58. tcgonnode = class(tonnode)
  59. procedure pass_2;override;
  60. end;
  61. implementation
  62. uses
  63. verbose,globals,systems,globtype,
  64. symconst,symsym,aasmbase,aasmtai,aasmcpu,defutil,
  65. cginfo,cgbase,pass_2,
  66. cpubase,cpuinfo,
  67. nld,ncon,
  68. ncgutil,
  69. tgobj,rgobj,paramgr,
  70. regvars,cgobj
  71. {$ifndef cpu64bit}
  72. ,cg64f32
  73. {$endif cpu64bit}
  74. ;
  75. const
  76. EXCEPT_BUF_SIZE = 12;
  77. {*****************************************************************************
  78. Second_While_RepeatN
  79. *****************************************************************************}
  80. procedure tcgwhilerepeatnode.pass_2;
  81. var
  82. lcont,lbreak,lloop,
  83. oldclabel,oldblabel : tasmlabel;
  84. otlabel,oflabel : tasmlabel;
  85. oldflowcontrol : tflowcontrol;
  86. begin
  87. location_reset(location,LOC_VOID,OS_NO);
  88. objectlibrary.getlabel(lloop);
  89. objectlibrary.getlabel(lcont);
  90. objectlibrary.getlabel(lbreak);
  91. { arrange continue and breaklabels: }
  92. oldflowcontrol:=flowcontrol;
  93. oldclabel:=aktcontinuelabel;
  94. oldblabel:=aktbreaklabel;
  95. load_all_regvars(exprasmlist);
  96. { handling code at the end as it is much more efficient, and makes
  97. while equal to repeat loop, only the end true/false is swapped (PFV) }
  98. if lnf_testatbegin in loopflags then
  99. cg.a_jmp_always(exprasmlist,lcont);
  100. if not(cs_littlesize in aktglobalswitches) then
  101. { align loop target }
  102. exprasmList.concat(Tai_align.Create(aktalignment.loopalign));
  103. cg.a_label(exprasmlist,lloop);
  104. aktcontinuelabel:=lcont;
  105. aktbreaklabel:=lbreak;
  106. {$ifndef newra}
  107. rg.cleartempgen;
  108. {$endif}
  109. if assigned(right) then
  110. secondpass(right);
  111. load_all_regvars(exprasmlist);
  112. cg.a_label(exprasmlist,lcont);
  113. otlabel:=truelabel;
  114. oflabel:=falselabel;
  115. if lnf_checknegate in loopflags then
  116. begin
  117. truelabel:=lbreak;
  118. falselabel:=lloop;
  119. end
  120. else
  121. begin
  122. truelabel:=lloop;
  123. falselabel:=lbreak;
  124. end;
  125. {$ifndef newra}
  126. rg.cleartempgen;
  127. {$endif}
  128. secondpass(left);
  129. maketojumpbool(exprasmlist,left,lr_load_regvars);
  130. cg.a_label(exprasmlist,lbreak);
  131. truelabel:=otlabel;
  132. falselabel:=oflabel;
  133. aktcontinuelabel:=oldclabel;
  134. aktbreaklabel:=oldblabel;
  135. { a break/continue in a while/repeat block can't be seen outside }
  136. flowcontrol:=oldflowcontrol+(flowcontrol-[fc_break,fc_continue]);
  137. end;
  138. {*****************************************************************************
  139. tcgIFNODE
  140. *****************************************************************************}
  141. procedure tcgifnode.pass_2;
  142. var
  143. hl,otlabel,oflabel : tasmlabel;
  144. {$ifdef i386}
  145. org_regvar_loaded_other,
  146. then_regvar_loaded_other,
  147. else_regvar_loaded_other : regvarother_booleanarray;
  148. org_regvar_loaded_int,
  149. then_regvar_loaded_int,
  150. else_regvar_loaded_int : Tsupregset;
  151. org_list,
  152. then_list,
  153. else_list : taasmoutput;
  154. {$endif i386}
  155. begin
  156. location_reset(location,LOC_VOID,OS_NO);
  157. otlabel:=truelabel;
  158. oflabel:=falselabel;
  159. objectlibrary.getlabel(truelabel);
  160. objectlibrary.getlabel(falselabel);
  161. {$ifndef newra}
  162. rg.cleartempgen;
  163. {$endif}
  164. secondpass(left);
  165. {$ifdef i386}
  166. { save regvars loaded in the beginning so that we can restore them }
  167. { when processing the else-block }
  168. if cs_regvars in aktglobalswitches then
  169. begin
  170. org_list := exprasmlist;
  171. exprasmlist := taasmoutput.create;
  172. end;
  173. {$endif i386}
  174. maketojumpbool(exprasmlist,left,lr_dont_load_regvars);
  175. {$ifdef i386}
  176. if cs_regvars in aktglobalswitches then
  177. begin
  178. org_regvar_loaded_int := rg.regvar_loaded_int;
  179. org_regvar_loaded_other := rg.regvar_loaded_other;
  180. end;
  181. {$endif i386}
  182. if assigned(right) then
  183. begin
  184. cg.a_label(exprasmlist,truelabel);
  185. {$ifndef newra}
  186. rg.cleartempgen;
  187. {$endif}
  188. secondpass(right);
  189. end;
  190. {$ifdef i386}
  191. { save current asmlist (previous instructions + then-block) and }
  192. { loaded regvar state and create new clean ones }
  193. if cs_regvars in aktglobalswitches then
  194. begin
  195. then_regvar_loaded_int := rg.regvar_loaded_int;
  196. then_regvar_loaded_other := rg.regvar_loaded_other;
  197. rg.regvar_loaded_int := org_regvar_loaded_int;
  198. rg.regvar_loaded_other := org_regvar_loaded_other;
  199. then_list := exprasmlist;
  200. exprasmlist := taasmoutput.create;
  201. end;
  202. {$endif i386}
  203. if assigned(t1) then
  204. begin
  205. if assigned(right) then
  206. begin
  207. objectlibrary.getlabel(hl);
  208. { do go back to if line !! }
  209. {$ifdef i386}
  210. if not(cs_regvars in aktglobalswitches) then
  211. {$endif i386}
  212. aktfilepos:=exprasmList.getlasttaifilepos^
  213. {$ifdef i386}
  214. else
  215. aktfilepos:=then_list.getlasttaifilepos^
  216. {$endif i386}
  217. ;
  218. cg.a_jmp_always(exprasmlist,hl);
  219. end;
  220. cg.a_label(exprasmlist,falselabel);
  221. {$ifndef newra}
  222. rg.cleartempgen;
  223. {$endif}
  224. secondpass(t1);
  225. {$ifdef i386}
  226. { save current asmlist (previous instructions + else-block) }
  227. { and loaded regvar state and create a new clean list }
  228. if cs_regvars in aktglobalswitches then
  229. begin
  230. else_regvar_loaded_int := rg.regvar_loaded_int;
  231. else_regvar_loaded_other := rg.regvar_loaded_other;
  232. else_list := exprasmlist;
  233. exprasmlist := taasmoutput.create;
  234. end;
  235. {$endif i386}
  236. if assigned(right) then
  237. cg.a_label(exprasmlist,hl);
  238. end
  239. else
  240. begin
  241. {$ifdef i386}
  242. if cs_regvars in aktglobalswitches then
  243. begin
  244. else_regvar_loaded_int := rg.regvar_loaded_int;
  245. else_regvar_loaded_other := rg.regvar_loaded_other;
  246. else_list := exprasmlist;
  247. exprasmlist := taasmoutput.create;
  248. end;
  249. {$endif i386}
  250. cg.a_label(exprasmlist,falselabel);
  251. end;
  252. if not(assigned(right)) then
  253. begin
  254. cg.a_label(exprasmlist,truelabel);
  255. end;
  256. {$ifdef i386}
  257. if cs_regvars in aktglobalswitches then
  258. begin
  259. { add loads of regvars at the end of the then- and else-blocks }
  260. { so that at the end of both blocks the same regvars are loaded }
  261. { no else block? }
  262. if not assigned(t1) then
  263. begin
  264. sync_regvars_int(org_list,then_list,org_regvar_loaded_int,then_regvar_loaded_int);
  265. sync_regvars_other(org_list,then_list,org_regvar_loaded_other,then_regvar_loaded_other);
  266. end
  267. { no then block? }
  268. else if not assigned(right) then
  269. begin
  270. sync_regvars_int(org_list,else_list,org_regvar_loaded_int,else_regvar_loaded_int);
  271. sync_regvars_other(org_list,else_list,org_regvar_loaded_other,else_regvar_loaded_other);
  272. end
  273. { both else and then blocks }
  274. else
  275. begin
  276. sync_regvars_int(then_list,else_list,then_regvar_loaded_int,else_regvar_loaded_int);
  277. sync_regvars_other(then_list,else_list,then_regvar_loaded_other,else_regvar_loaded_other);
  278. end;
  279. { add all lists together }
  280. org_list.concatlist(then_list);
  281. then_list.free;
  282. org_list.concatlist(else_list);
  283. else_list.free;
  284. org_list.concatlist(exprasmlist);
  285. exprasmlist.free;
  286. exprasmlist := org_list;
  287. end;
  288. {$endif i386}
  289. truelabel:=otlabel;
  290. falselabel:=oflabel;
  291. end;
  292. {*****************************************************************************
  293. SecondFor
  294. *****************************************************************************}
  295. procedure tcgfornode.pass_2;
  296. var
  297. l3,oldclabel,oldblabel : tasmlabel;
  298. temptovalue : boolean;
  299. hs : byte;
  300. temp1 : treference;
  301. hop : topcg;
  302. hcond : topcmp;
  303. opsize : tcgsize;
  304. count_var_is_signed,do_loopvar_at_end : boolean;
  305. cmp_const:Tconstexprint;
  306. oldflowcontrol : tflowcontrol;
  307. begin
  308. location_reset(location,LOC_VOID,OS_NO);
  309. oldflowcontrol:=flowcontrol;
  310. oldclabel:=aktcontinuelabel;
  311. oldblabel:=aktbreaklabel;
  312. objectlibrary.getlabel(aktcontinuelabel);
  313. objectlibrary.getlabel(aktbreaklabel);
  314. objectlibrary.getlabel(l3);
  315. { only calculate reference }
  316. {$ifndef newra}
  317. rg.cleartempgen;
  318. {$endif}
  319. secondpass(t2);
  320. hs := t2.resulttype.def.size;
  321. opsize := def_cgsize(t2.resulttype.def);
  322. { first set the to value
  323. because the count var can be in the expression !! }
  324. {$ifndef newra}
  325. rg.cleartempgen;
  326. {$endif}
  327. do_loopvar_at_end:=lnf_dont_mind_loopvar_on_exit in loopflags;
  328. secondpass(right);
  329. { calculate pointer value and check if changeable and if so }
  330. { load into temporary variable }
  331. if right.nodetype<>ordconstn then
  332. begin
  333. do_loopvar_at_end:=false;
  334. tg.GetTemp(exprasmlist,hs,tt_normal,temp1);
  335. temptovalue:=true;
  336. if (right.location.loc=LOC_REGISTER) or
  337. (right.location.loc=LOC_CREGISTER) then
  338. begin
  339. cg.a_load_reg_ref(exprasmlist,opsize,opsize,right.location.register,temp1);
  340. rg.ungetregisterint(exprasmlist,right.location.register);
  341. end
  342. else
  343. cg.g_concatcopy(exprasmlist,right.location.reference,temp1,
  344. hs,true,false);
  345. end
  346. else
  347. temptovalue:=false;
  348. { produce start assignment }
  349. {$ifndef newra}
  350. rg.cleartempgen;
  351. {$endif}
  352. secondpass(left);
  353. count_var_is_signed:=is_signed(t2.resulttype.def);
  354. if lnf_backward in loopflags then
  355. if count_var_is_signed then
  356. hcond:=OC_LT
  357. else
  358. hcond:=OC_B
  359. else
  360. if count_var_is_signed then
  361. hcond:=OC_GT
  362. else
  363. hcond:=OC_A;
  364. load_all_regvars(exprasmlist);
  365. if temptovalue then
  366. begin
  367. cg.a_cmp_ref_loc_label(exprasmlist,opsize,hcond,
  368. temp1,t2.location,aktbreaklabel);
  369. end
  370. else
  371. begin
  372. if lnf_testatbegin in loopflags then
  373. begin
  374. cg.a_cmp_const_loc_label(exprasmlist,opsize,hcond,
  375. aword(tordconstnode(right).value),
  376. t2.location,aktbreaklabel);
  377. end;
  378. end;
  379. {If the loopvar doesn't mind on exit, we avoid this ugly
  380. dec instruction and do the loopvar inc/dec after the loop
  381. body.}
  382. if not do_loopvar_at_end then
  383. begin
  384. if lnf_backward in loopflags then
  385. hop:=OP_ADD
  386. else
  387. hop:=OP_SUB;
  388. cg.a_op_const_loc(exprasmlist,hop,1,t2.location);
  389. end;
  390. if not(cs_littlesize in aktglobalswitches) then
  391. { align loop target }
  392. exprasmList.concat(Tai_align.Create(aktalignment.loopalign));
  393. cg.a_label(exprasmlist,l3);
  394. {If the loopvar doesn't mind on exit, we avoid the loopvar inc/dec
  395. after the loop body instead of here.}
  396. if not do_loopvar_at_end then
  397. begin
  398. { according to count direction DEC or INC... }
  399. if lnf_backward in loopflags then
  400. hop:=OP_SUB
  401. else
  402. hop:=OP_ADD;
  403. cg.a_op_const_loc(exprasmlist,hop,1,t2.location);
  404. end;
  405. { help register must not be in instruction block }
  406. {$ifndef newra}
  407. rg.cleartempgen;
  408. {$endif}
  409. if assigned(t1) then
  410. begin
  411. secondpass(t1);
  412. load_all_regvars(exprasmlist);
  413. end;
  414. {If the loopvar doesn't mind on exit, we do the loopvar inc/dec
  415. after the loop body instead of here.}
  416. if do_loopvar_at_end then
  417. begin
  418. { according to count direction DEC or INC... }
  419. if lnf_backward in loopflags then
  420. hop:=OP_SUB
  421. else
  422. hop:=OP_ADD;
  423. cg.a_op_const_loc(exprasmlist,hop,1,t2.location);
  424. end;
  425. cg.a_label(exprasmlist,aktcontinuelabel);
  426. { makes no problems there }
  427. {$ifndef newra}
  428. rg.cleartempgen;
  429. {$endif}
  430. if do_loopvar_at_end then
  431. if lnf_backward in loopflags then
  432. if count_var_is_signed then
  433. hcond:=OC_GTE
  434. else
  435. hcond:=OC_AE
  436. else
  437. if count_var_is_signed then
  438. hcond:=OC_LTE
  439. else
  440. hcond:=OC_BE
  441. else
  442. if lnf_backward in loopflags then
  443. if count_var_is_signed then
  444. hcond:=OC_GT
  445. else
  446. hcond:=OC_A
  447. else
  448. if count_var_is_signed then
  449. hcond:=OC_LT
  450. else
  451. hcond:=OC_B;
  452. load_all_regvars(exprasmlist);
  453. cmp_const:=aword(Tordconstnode(right).value);
  454. if do_loopvar_at_end then
  455. begin
  456. {Watch out for wrap around 255 -> 0.}
  457. {Ugly: This code is way to long... Use tables?}
  458. case opsize of
  459. OS_8:
  460. begin
  461. if lnf_backward in loopflags then
  462. begin
  463. if byte(cmp_const)=low(byte) then
  464. begin
  465. hcond:=OC_NE;
  466. cmp_const:=high(byte);
  467. end
  468. end
  469. else
  470. begin
  471. if byte(cmp_const)=high(byte) then
  472. begin
  473. hcond:=OC_NE;
  474. cmp_const:=low(byte);
  475. end
  476. end
  477. end;
  478. OS_16:
  479. begin
  480. if lnf_backward in loopflags then
  481. begin
  482. if word(cmp_const)=high(word) then
  483. begin
  484. hcond:=OC_NE;
  485. cmp_const:=low(word);
  486. end
  487. end
  488. else
  489. begin
  490. if word(cmp_const)=low(word) then
  491. begin
  492. hcond:=OC_NE;
  493. cmp_const:=high(word);
  494. end
  495. end
  496. end;
  497. OS_32:
  498. begin
  499. if lnf_backward in loopflags then
  500. begin
  501. if cardinal(cmp_const)=high(cardinal) then
  502. begin
  503. hcond:=OC_NE;
  504. cmp_const:=low(cardinal);
  505. end
  506. end
  507. else
  508. begin
  509. if cardinal(cmp_const)=low(cardinal) then
  510. begin
  511. hcond:=OC_NE;
  512. cmp_const:=high(cardinal);
  513. end
  514. end
  515. end;
  516. OS_64:
  517. begin
  518. if lnf_backward in loopflags then
  519. begin
  520. if qword(cmp_const)=high(qword) then
  521. begin
  522. hcond:=OC_NE;
  523. cmp_const:=low(qword);
  524. end
  525. end
  526. else
  527. begin
  528. if qword(cmp_const)=low(qword) then
  529. begin
  530. hcond:=OC_NE;
  531. cmp_const:=high(qword);
  532. end
  533. end
  534. end;
  535. OS_S8:
  536. begin
  537. if lnf_backward in loopflags then
  538. begin
  539. if shortint(cmp_const)=low(shortint) then
  540. begin
  541. hcond:=OC_NE;
  542. cmp_const:=high(shortint);
  543. end
  544. end
  545. else
  546. begin
  547. if shortint(cmp_const)=high(shortint) then
  548. begin
  549. hcond:=OC_NE;
  550. cmp_const:=low(shortint);
  551. end
  552. end
  553. end;
  554. OS_S16:
  555. begin
  556. if lnf_backward in loopflags then
  557. begin
  558. if integer(cmp_const)=high(integer) then
  559. begin
  560. hcond:=OC_NE;
  561. cmp_const:=low(integer);
  562. end
  563. end
  564. else
  565. begin
  566. if integer(cmp_const)=low(integer) then
  567. begin
  568. hcond:=OC_NE;
  569. cmp_const:=high(integer);
  570. end
  571. end
  572. end;
  573. OS_S32:
  574. begin
  575. if lnf_backward in loopflags then
  576. begin
  577. if longint(cmp_const)=high(longint) then
  578. begin
  579. hcond:=OC_NE;
  580. cmp_const:=low(longint);
  581. end
  582. end
  583. else
  584. begin
  585. if longint(cmp_const)=low(longint) then
  586. begin
  587. hcond:=OC_NE;
  588. cmp_const:=high(longint);
  589. end
  590. end
  591. end;
  592. OS_S64:
  593. begin
  594. if lnf_backward in loopflags then
  595. begin
  596. if int64(cmp_const)=high(int64) then
  597. begin
  598. hcond:=OC_NE;
  599. cmp_const:=low(int64);
  600. end
  601. end
  602. else
  603. begin
  604. if int64(cmp_const)=low(int64) then
  605. begin
  606. hcond:=OC_NE;
  607. cmp_const:=high(int64);
  608. end
  609. end
  610. end;
  611. else
  612. internalerror(200201021);
  613. end;
  614. end;
  615. { produce comparison and the corresponding }
  616. { jump }
  617. if temptovalue then
  618. begin
  619. cg.a_cmp_ref_loc_label(exprasmlist,opsize,hcond,temp1,
  620. t2.location,l3);
  621. end
  622. else
  623. begin
  624. cg.a_cmp_const_loc_label(exprasmlist,opsize,hcond,
  625. cmp_const,t2.location,l3);
  626. end;
  627. if temptovalue then
  628. tg.ungetiftemp(exprasmlist,temp1);
  629. { this is the break label: }
  630. cg.a_label(exprasmlist,aktbreaklabel);
  631. aktcontinuelabel:=oldclabel;
  632. aktbreaklabel:=oldblabel;
  633. { a break/continue in a while/repeat block can't be seen outside }
  634. flowcontrol:=oldflowcontrol+(flowcontrol-[fc_break,fc_continue]);
  635. end;
  636. {*****************************************************************************
  637. SecondExitN
  638. *****************************************************************************}
  639. procedure tcgexitnode.pass_2;
  640. begin
  641. location_reset(location,LOC_VOID,OS_NO);
  642. include(flowcontrol,fc_exit);
  643. if assigned(left) then
  644. secondpass(left);
  645. cg.a_jmp_always(exprasmlist,current_procinfo.aktexitlabel);
  646. end;
  647. {*****************************************************************************
  648. SecondBreakN
  649. *****************************************************************************}
  650. procedure tcgbreaknode.pass_2;
  651. begin
  652. location_reset(location,LOC_VOID,OS_NO);
  653. include(flowcontrol,fc_break);
  654. if aktbreaklabel<>nil then
  655. begin
  656. load_all_regvars(exprasmlist);
  657. cg.a_jmp_always(exprasmlist,aktbreaklabel)
  658. end
  659. else
  660. CGMessage(cg_e_break_not_allowed);
  661. end;
  662. {*****************************************************************************
  663. SecondContinueN
  664. *****************************************************************************}
  665. procedure tcgcontinuenode.pass_2;
  666. begin
  667. location_reset(location,LOC_VOID,OS_NO);
  668. include(flowcontrol,fc_continue);
  669. if aktcontinuelabel<>nil then
  670. begin
  671. load_all_regvars(exprasmlist);
  672. cg.a_jmp_always(exprasmlist,aktcontinuelabel)
  673. end
  674. else
  675. CGMessage(cg_e_continue_not_allowed);
  676. end;
  677. {*****************************************************************************
  678. SecondGoto
  679. *****************************************************************************}
  680. procedure tcggotonode.pass_2;
  681. begin
  682. location_reset(location,LOC_VOID,OS_NO);
  683. load_all_regvars(exprasmlist);
  684. cg.a_jmp_always(exprasmlist,labsym.lab)
  685. end;
  686. {*****************************************************************************
  687. SecondLabel
  688. *****************************************************************************}
  689. procedure tcglabelnode.pass_2;
  690. begin
  691. location_reset(location,LOC_VOID,OS_NO);
  692. load_all_regvars(exprasmlist);
  693. cg.a_label(exprasmlist,labelnr);
  694. {$ifndef newra}
  695. rg.cleartempgen;
  696. {$endif newra}
  697. secondpass(left);
  698. end;
  699. {*****************************************************************************
  700. SecondRaise
  701. *****************************************************************************}
  702. procedure tcgraisenode.pass_2;
  703. var
  704. a : tasmlabel;
  705. href2: treference;
  706. r:Tregister;
  707. begin
  708. location_reset(location,LOC_VOID,OS_NO);
  709. if assigned(left) then
  710. begin
  711. {$ifdef callparatemp}
  712. { process object (may contain a call) }
  713. secondpass(left);
  714. if codegenerror then
  715. exit;
  716. {$endif callparatemp}
  717. { multiple parameters? }
  718. if assigned(right) then
  719. begin
  720. {$ifdef callparatemp}
  721. { process address (in case it contains a call) }
  722. secondpass(right);
  723. if codegenerror then
  724. exit;
  725. {$endif callparatemp}
  726. { push frame }
  727. if assigned(frametree) then
  728. begin
  729. secondpass(frametree);
  730. if codegenerror then
  731. exit;
  732. cg.a_param_loc(exprasmlist,frametree.location,paramanager.getintparaloc(exprasmlist,3));
  733. end
  734. else
  735. cg.a_param_const(exprasmlist,OS_INT,0,paramanager.getintparaloc(exprasmlist,3));
  736. {$ifndef callparatemp}
  737. { push address }
  738. secondpass(right);
  739. if codegenerror then
  740. exit;
  741. {$endif not callparatemp}
  742. cg.a_param_loc(exprasmlist,right.location,paramanager.getintparaloc(exprasmlist,2));
  743. end
  744. else
  745. begin
  746. { get current address }
  747. objectlibrary.getaddrlabel(a);
  748. cg.a_label(exprasmlist,a);
  749. reference_reset_symbol(href2,a,0);
  750. { push current frame }
  751. r.enum:=R_INTREGISTER;
  752. r.number:=NR_FRAME_POINTER_REG;
  753. cg.a_param_reg(exprasmlist,OS_ADDR,r,paramanager.getintparaloc(exprasmlist,3));
  754. { push current address }
  755. if target_info.system <> system_powerpc_macos then
  756. cg.a_paramaddr_ref(exprasmlist,href2,paramanager.getintparaloc(exprasmlist,2))
  757. else
  758. cg.a_param_const(exprasmlist,OS_INT,0,paramanager.getintparaloc(exprasmlist,2));
  759. end;
  760. {$ifndef callparatemp}
  761. { push object }
  762. secondpass(left);
  763. if codegenerror then
  764. exit;
  765. {$endif not callparatemp}
  766. cg.a_param_loc(exprasmlist,left.location,paramanager.getintparaloc(exprasmlist,1));
  767. paramanager.freeintparaloc(exprasmlist,3);
  768. paramanager.freeintparaloc(exprasmlist,2);
  769. paramanager.freeintparaloc(exprasmlist,1);
  770. {$ifdef newra}
  771. rg.allocexplicitregistersint(exprasmlist,VOLATILE_INTREGISTERS);
  772. {$endif newra}
  773. cg.a_call_name(exprasmlist,'FPC_RAISEEXCEPTION');
  774. {$ifdef newra}
  775. rg.deallocexplicitregistersint(exprasmlist,VOLATILE_INTREGISTERS);
  776. {$endif newra}
  777. end
  778. else
  779. begin
  780. {$ifdef newra}
  781. rg.allocexplicitregistersint(exprasmlist,VOLATILE_INTREGISTERS);
  782. {$endif newra}
  783. cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK');
  784. cg.a_call_name(exprasmlist,'FPC_RERAISE');
  785. {$ifdef newra}
  786. rg.deallocexplicitregistersint(exprasmlist,VOLATILE_INTREGISTERS);
  787. {$endif newra}
  788. end;
  789. end;
  790. {*****************************************************************************
  791. SecondTryExcept
  792. *****************************************************************************}
  793. var
  794. endexceptlabel : tasmlabel;
  795. procedure try_new_exception(list : taasmoutput;var jmpbuf,envbuf, href : treference;
  796. a : aword; exceptlabel : tasmlabel);
  797. begin
  798. tg.GetTemp(list,EXCEPT_BUF_SIZE,tt_persistent,envbuf);
  799. tg.GetTemp(list,JMP_BUF_SIZE,tt_persistent,jmpbuf);
  800. tg.GetTemp(list,sizeof(aword),tt_persistent,href);
  801. new_exception(list, jmpbuf,envbuf, href, a, exceptlabel);
  802. end;
  803. procedure try_free_exception(list : taasmoutput;var jmpbuf, envbuf, href : treference;
  804. a : aword ; endexceptlabel : tasmlabel; onlyfree : boolean);
  805. begin
  806. free_exception(list, jmpbuf, envbuf, href, a, endexceptlabel, onlyfree);
  807. tg.ungettemp(list,href);
  808. tg.Ungettemp(list,jmpbuf);
  809. tg.ungettemp(list,envbuf);
  810. end;
  811. { does the necessary things to clean up the object stack }
  812. { in the except block }
  813. procedure cleanupobjectstack;
  814. var r:Tregister;
  815. begin
  816. {$ifdef newra}
  817. rg.allocexplicitregistersint(exprasmlist,VOLATILE_INTREGISTERS);
  818. {$endif newra}
  819. cg.a_call_name(exprasmlist,'FPC_POPOBJECTSTACK');
  820. {$ifdef newra}
  821. rg.deallocexplicitregistersint(exprasmlist,VOLATILE_INTREGISTERS);
  822. {$endif newra}
  823. r.enum:=R_INTREGISTER;
  824. r.number:=NR_FUNCTION_RESULT_REG;
  825. cg.a_param_reg(exprasmlist,OS_ADDR,r,paramanager.getintparaloc(exprasmlist,1));
  826. paramanager.freeintparaloc(exprasmlist,1);
  827. {$ifdef newra}
  828. rg.allocexplicitregistersint(exprasmlist,VOLATILE_INTREGISTERS);
  829. {$endif newra}
  830. cg.a_call_name(exprasmlist,'FPC_DESTROYEXCEPTION');
  831. {$ifdef newra}
  832. rg.deallocexplicitregistersint(exprasmlist,VOLATILE_INTREGISTERS);
  833. {$endif newra}
  834. end;
  835. procedure tcgtryexceptnode.pass_2;
  836. var
  837. exceptlabel,doexceptlabel,oldendexceptlabel,
  838. lastonlabel,
  839. exitexceptlabel,
  840. continueexceptlabel,
  841. breakexceptlabel,
  842. exittrylabel,
  843. continuetrylabel,
  844. breaktrylabel,
  845. doobjectdestroy,
  846. doobjectdestroyandreraise,
  847. oldaktexitlabel,
  848. oldaktcontinuelabel,
  849. oldaktbreaklabel : tasmlabel;
  850. oldflowcontrol,tryflowcontrol,
  851. exceptflowcontrol : tflowcontrol;
  852. tempbuf,tempaddr : treference;
  853. href : treference;
  854. r:Tregister;
  855. label
  856. errorexit;
  857. begin
  858. location_reset(location,LOC_VOID,OS_NO);
  859. oldflowcontrol:=flowcontrol;
  860. flowcontrol:=[];
  861. { this can be called recursivly }
  862. oldendexceptlabel:=endexceptlabel;
  863. { save the old labels for control flow statements }
  864. oldaktexitlabel:=current_procinfo.aktexitlabel;
  865. if assigned(aktbreaklabel) then
  866. begin
  867. oldaktcontinuelabel:=aktcontinuelabel;
  868. oldaktbreaklabel:=aktbreaklabel;
  869. end;
  870. { get new labels for the control flow statements }
  871. objectlibrary.getlabel(exittrylabel);
  872. objectlibrary.getlabel(exitexceptlabel);
  873. if assigned(aktbreaklabel) then
  874. begin
  875. objectlibrary.getlabel(breaktrylabel);
  876. objectlibrary.getlabel(continuetrylabel);
  877. objectlibrary.getlabel(breakexceptlabel);
  878. objectlibrary.getlabel(continueexceptlabel);
  879. end;
  880. objectlibrary.getlabel(exceptlabel);
  881. objectlibrary.getlabel(doexceptlabel);
  882. objectlibrary.getlabel(endexceptlabel);
  883. objectlibrary.getlabel(lastonlabel);
  884. try_new_exception(exprasmlist,tempbuf,tempaddr,href,1,exceptlabel);
  885. { try block }
  886. { set control flow labels for the try block }
  887. current_procinfo.aktexitlabel:=exittrylabel;
  888. if assigned(oldaktbreaklabel) then
  889. begin
  890. aktcontinuelabel:=continuetrylabel;
  891. aktbreaklabel:=breaktrylabel;
  892. end;
  893. flowcontrol:=[];
  894. secondpass(left);
  895. tryflowcontrol:=flowcontrol;
  896. if codegenerror then
  897. goto errorexit;
  898. cg.a_label(exprasmlist,exceptlabel);
  899. try_free_exception(exprasmlist,tempbuf,tempaddr,href,0,endexceptlabel,false);
  900. cg.a_label(exprasmlist,doexceptlabel);
  901. { set control flow labels for the except block }
  902. { and the on statements }
  903. current_procinfo.aktexitlabel:=exitexceptlabel;
  904. if assigned(oldaktbreaklabel) then
  905. begin
  906. aktcontinuelabel:=continueexceptlabel;
  907. aktbreaklabel:=breakexceptlabel;
  908. end;
  909. flowcontrol:=[];
  910. { on statements }
  911. if assigned(right) then
  912. secondpass(right);
  913. cg.a_label(exprasmlist,lastonlabel);
  914. { default handling except handling }
  915. if assigned(t1) then
  916. begin
  917. { FPC_CATCHES must be called with
  918. 'default handler' flag (=-1)
  919. }
  920. cg.a_param_const(exprasmlist,OS_ADDR,aword(-1),paramanager.getintparaloc(exprasmlist,1));
  921. paramanager.freeintparaloc(exprasmlist,1);
  922. {$ifdef newra}
  923. rg.allocexplicitregistersint(exprasmlist,VOLATILE_INTREGISTERS);
  924. {$endif newra}
  925. cg.a_call_name(exprasmlist,'FPC_CATCHES');
  926. {$ifdef newra}
  927. rg.deallocexplicitregistersint(exprasmlist,VOLATILE_INTREGISTERS);
  928. {$endif newra}
  929. { the destruction of the exception object must be also }
  930. { guarded by an exception frame }
  931. objectlibrary.getlabel(doobjectdestroy);
  932. objectlibrary.getlabel(doobjectdestroyandreraise);
  933. try_new_exception(exprasmlist,tempbuf,tempaddr,href,1,doobjectdestroyandreraise);
  934. { here we don't have to reset flowcontrol }
  935. { the default and on flowcontrols are handled equal }
  936. secondpass(t1);
  937. exceptflowcontrol:=flowcontrol;
  938. cg.a_label(exprasmlist,doobjectdestroyandreraise);
  939. try_free_exception(exprasmlist,tempbuf,tempaddr,href,0,doobjectdestroy,false);
  940. {$ifdef newra}
  941. rg.allocexplicitregistersint(exprasmlist,VOLATILE_INTREGISTERS);
  942. {$endif newra}
  943. cg.a_call_name(exprasmlist,'FPC_POPSECONDOBJECTSTACK');
  944. {$ifdef newra}
  945. rg.deallocexplicitregistersint(exprasmlist,VOLATILE_INTREGISTERS);
  946. {$endif newra}
  947. r.enum:=R_INTREGISTER;
  948. r.number:=NR_FUNCTION_RESULT_REG;
  949. cg.a_param_reg(exprasmlist, OS_ADDR, r, paramanager.getintparaloc(exprasmlist,1));
  950. paramanager.freeintparaloc(exprasmlist,1);
  951. {$ifdef newra}
  952. rg.allocexplicitregistersint(exprasmlist,VOLATILE_INTREGISTERS);
  953. {$endif newra}
  954. cg.a_call_name(exprasmlist,'FPC_DESTROYEXCEPTION');
  955. {$ifdef newra}
  956. rg.deallocexplicitregistersint(exprasmlist,VOLATILE_INTREGISTERS);
  957. {$endif newra}
  958. { we don't need to restore esi here because reraise never }
  959. { returns }
  960. cg.a_call_name(exprasmlist,'FPC_RERAISE');
  961. cg.a_label(exprasmlist,doobjectdestroy);
  962. cleanupobjectstack;
  963. cg.a_jmp_always(exprasmlist,endexceptlabel);
  964. end
  965. else
  966. begin
  967. cg.a_call_name(exprasmlist,'FPC_RERAISE');
  968. exceptflowcontrol:=flowcontrol;
  969. end;
  970. if fc_exit in exceptflowcontrol then
  971. begin
  972. { do some magic for exit in the try block }
  973. cg.a_label(exprasmlist,exitexceptlabel);
  974. { we must also destroy the address frame which guards }
  975. { exception object }
  976. {$ifdef newra}
  977. rg.allocexplicitregistersint(exprasmlist,VOLATILE_INTREGISTERS);
  978. {$endif newra}
  979. cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK');
  980. {$ifdef newra}
  981. rg.deallocexplicitregistersint(exprasmlist,VOLATILE_INTREGISTERS);
  982. {$endif newra}
  983. cg.g_exception_reason_load(exprasmlist,href);
  984. cleanupobjectstack;
  985. cg.a_jmp_always(exprasmlist,oldaktexitlabel);
  986. end;
  987. if fc_break in exceptflowcontrol then
  988. begin
  989. cg.a_label(exprasmlist,breakexceptlabel);
  990. { we must also destroy the address frame which guards }
  991. { exception object }
  992. {$ifdef newra}
  993. rg.allocexplicitregistersint(exprasmlist,VOLATILE_INTREGISTERS);
  994. {$endif newra}
  995. cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK');
  996. {$ifdef newra}
  997. rg.deallocexplicitregistersint(exprasmlist,VOLATILE_INTREGISTERS);
  998. {$endif newra}
  999. cg.g_exception_reason_load(exprasmlist,href);
  1000. cleanupobjectstack;
  1001. cg.a_jmp_always(exprasmlist,oldaktbreaklabel);
  1002. end;
  1003. if fc_continue in exceptflowcontrol then
  1004. begin
  1005. cg.a_label(exprasmlist,continueexceptlabel);
  1006. { we must also destroy the address frame which guards }
  1007. { exception object }
  1008. {$ifdef newra}
  1009. rg.allocexplicitregistersint(exprasmlist,VOLATILE_INTREGISTERS);
  1010. {$endif newra}
  1011. cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK');
  1012. {$ifdef newra}
  1013. rg.deallocexplicitregistersint(exprasmlist,VOLATILE_INTREGISTERS);
  1014. {$endif newra}
  1015. cg.g_exception_reason_load(exprasmlist,href);
  1016. cleanupobjectstack;
  1017. cg.a_jmp_always(exprasmlist,oldaktcontinuelabel);
  1018. end;
  1019. if fc_exit in tryflowcontrol then
  1020. begin
  1021. { do some magic for exit in the try block }
  1022. cg.a_label(exprasmlist,exittrylabel);
  1023. {$ifdef newra}
  1024. rg.allocexplicitregistersint(exprasmlist,VOLATILE_INTREGISTERS);
  1025. {$endif newra}
  1026. cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK');
  1027. {$ifdef newra}
  1028. rg.deallocexplicitregistersint(exprasmlist,VOLATILE_INTREGISTERS);
  1029. {$endif newra}
  1030. cg.g_exception_reason_load(exprasmlist,href);
  1031. cg.a_jmp_always(exprasmlist,oldaktexitlabel);
  1032. end;
  1033. if fc_break in tryflowcontrol then
  1034. begin
  1035. cg.a_label(exprasmlist,breaktrylabel);
  1036. {$ifdef newra}
  1037. rg.allocexplicitregistersint(exprasmlist,VOLATILE_INTREGISTERS);
  1038. {$endif newra}
  1039. cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK');
  1040. {$ifdef newra}
  1041. rg.deallocexplicitregistersint(exprasmlist,VOLATILE_INTREGISTERS);
  1042. {$endif newra}
  1043. cg.g_exception_reason_load(exprasmlist,href);
  1044. cg.a_jmp_always(exprasmlist,oldaktbreaklabel);
  1045. end;
  1046. if fc_continue in tryflowcontrol then
  1047. begin
  1048. cg.a_label(exprasmlist,continuetrylabel);
  1049. {$ifdef newra}
  1050. rg.allocexplicitregistersint(exprasmlist,VOLATILE_INTREGISTERS);
  1051. {$endif newra}
  1052. cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK');
  1053. {$ifdef newra}
  1054. rg.deallocexplicitregistersint(exprasmlist,VOLATILE_INTREGISTERS);
  1055. {$endif newra}
  1056. cg.g_exception_reason_load(exprasmlist,href);
  1057. cg.a_jmp_always(exprasmlist,oldaktcontinuelabel);
  1058. end;
  1059. cg.a_label(exprasmlist,endexceptlabel);
  1060. errorexit:
  1061. { restore all saved labels }
  1062. endexceptlabel:=oldendexceptlabel;
  1063. { restore the control flow labels }
  1064. current_procinfo.aktexitlabel:=oldaktexitlabel;
  1065. if assigned(oldaktbreaklabel) then
  1066. begin
  1067. aktcontinuelabel:=oldaktcontinuelabel;
  1068. aktbreaklabel:=oldaktbreaklabel;
  1069. end;
  1070. { return all used control flow statements }
  1071. flowcontrol:=oldflowcontrol+exceptflowcontrol+
  1072. tryflowcontrol;
  1073. end;
  1074. procedure tcgonnode.pass_2;
  1075. var
  1076. nextonlabel,
  1077. exitonlabel,
  1078. continueonlabel,
  1079. breakonlabel,
  1080. oldaktexitlabel,
  1081. oldaktcontinuelabel,
  1082. doobjectdestroyandreraise,
  1083. doobjectdestroy,
  1084. oldaktbreaklabel : tasmlabel;
  1085. ref : treference;
  1086. oldflowcontrol : tflowcontrol;
  1087. tempbuf,tempaddr : treference;
  1088. href : treference;
  1089. href2: treference;
  1090. r:Tregister;
  1091. begin
  1092. location_reset(location,LOC_VOID,OS_NO);
  1093. oldflowcontrol:=flowcontrol;
  1094. flowcontrol:=[];
  1095. objectlibrary.getlabel(nextonlabel);
  1096. { send the vmt parameter }
  1097. reference_reset_symbol(href2,objectlibrary.newasmsymboldata(excepttype.vmt_mangledname),0);
  1098. cg.a_paramaddr_ref(exprasmlist,href2,paramanager.getintparaloc(exprasmlist,1));
  1099. paramanager.freeintparaloc(exprasmlist,1);
  1100. {$ifdef newra}
  1101. rg.allocexplicitregistersint(exprasmlist,VOLATILE_INTREGISTERS);
  1102. {$endif newra}
  1103. cg.a_call_name(exprasmlist,'FPC_CATCHES');
  1104. {$ifdef newra}
  1105. rg.deallocexplicitregistersint(exprasmlist,VOLATILE_INTREGISTERS);
  1106. {$endif newra}
  1107. { is it this catch? No. go to next onlabel }
  1108. r.enum:=R_INTREGISTER;
  1109. r.number:=NR_FUNCTION_RESULT_REG;
  1110. cg.a_cmp_const_reg_label(exprasmlist,OS_ADDR,OC_EQ,0,r,nextonlabel);
  1111. ref.symbol:=nil;
  1112. tg.GetTemp(exprasmlist,pointer_size,tt_normal,ref);
  1113. { what a hack ! }
  1114. if assigned(exceptsymtable) then
  1115. tvarsym(exceptsymtable.symindex.first).address:=ref.offset;
  1116. cg.a_load_reg_ref(exprasmlist,OS_ADDR,OS_ADDR,r,ref);
  1117. { in the case that another exception is risen }
  1118. { we've to destroy the old one }
  1119. objectlibrary.getlabel(doobjectdestroyandreraise);
  1120. { call setjmp, and jump to finally label on non-zero result }
  1121. try_new_exception(exprasmlist,tempbuf,tempaddr,href,1,doobjectdestroyandreraise);
  1122. if assigned(right) then
  1123. begin
  1124. oldaktexitlabel:=current_procinfo.aktexitlabel;
  1125. objectlibrary.getlabel(exitonlabel);
  1126. current_procinfo.aktexitlabel:=exitonlabel;
  1127. if assigned(aktbreaklabel) then
  1128. begin
  1129. oldaktcontinuelabel:=aktcontinuelabel;
  1130. oldaktbreaklabel:=aktbreaklabel;
  1131. objectlibrary.getlabel(breakonlabel);
  1132. objectlibrary.getlabel(continueonlabel);
  1133. aktcontinuelabel:=continueonlabel;
  1134. aktbreaklabel:=breakonlabel;
  1135. end;
  1136. secondpass(right);
  1137. end;
  1138. objectlibrary.getlabel(doobjectdestroy);
  1139. cg.a_label(exprasmlist,doobjectdestroyandreraise);
  1140. try_free_exception(exprasmlist,tempbuf,tempaddr,href,0,doobjectdestroy,false);
  1141. {$ifdef newra}
  1142. rg.allocexplicitregistersint(exprasmlist,VOLATILE_INTREGISTERS);
  1143. {$endif newra}
  1144. cg.a_call_name(exprasmlist,'FPC_POPSECONDOBJECTSTACK');
  1145. {$ifdef newra}
  1146. rg.deallocexplicitregistersint(exprasmlist,VOLATILE_INTREGISTERS);
  1147. {$endif newra}
  1148. cg.a_param_reg(exprasmlist, OS_ADDR, r, paramanager.getintparaloc(exprasmlist,1));
  1149. paramanager.freeintparaloc(exprasmlist,1);
  1150. {$ifdef newra}
  1151. rg.allocexplicitregistersint(exprasmlist,VOLATILE_INTREGISTERS);
  1152. {$endif newra}
  1153. cg.a_call_name(exprasmlist,'FPC_DESTROYEXCEPTION');
  1154. {$ifdef newra}
  1155. rg.deallocexplicitregistersint(exprasmlist,VOLATILE_INTREGISTERS);
  1156. {$endif newra}
  1157. { we don't need to restore esi here because reraise never }
  1158. { returns }
  1159. cg.a_call_name(exprasmlist,'FPC_RERAISE');
  1160. cg.a_label(exprasmlist,doobjectdestroy);
  1161. cleanupobjectstack;
  1162. { clear some stuff }
  1163. tg.ungetiftemp(exprasmlist,ref);
  1164. cg.a_jmp_always(exprasmlist,endexceptlabel);
  1165. if assigned(right) then
  1166. begin
  1167. { special handling for control flow instructions }
  1168. if fc_exit in flowcontrol then
  1169. begin
  1170. { the address and object pop does secondtryexcept }
  1171. cg.a_label(exprasmlist,exitonlabel);
  1172. cg.a_jmp_always(exprasmlist,oldaktexitlabel);
  1173. end;
  1174. if fc_break in flowcontrol then
  1175. begin
  1176. { the address and object pop does secondtryexcept }
  1177. cg.a_label(exprasmlist,breakonlabel);
  1178. cg.a_jmp_always(exprasmlist,oldaktbreaklabel);
  1179. end;
  1180. if fc_continue in flowcontrol then
  1181. begin
  1182. { the address and object pop does secondtryexcept }
  1183. cg.a_label(exprasmlist,continueonlabel);
  1184. cg.a_jmp_always(exprasmlist,oldaktcontinuelabel);
  1185. end;
  1186. current_procinfo.aktexitlabel:=oldaktexitlabel;
  1187. if assigned(oldaktbreaklabel) then
  1188. begin
  1189. aktcontinuelabel:=oldaktcontinuelabel;
  1190. aktbreaklabel:=oldaktbreaklabel;
  1191. end;
  1192. end;
  1193. cg.a_label(exprasmlist,nextonlabel);
  1194. flowcontrol:=oldflowcontrol+flowcontrol;
  1195. { next on node }
  1196. if assigned(left) then
  1197. begin
  1198. {$ifndef newra}
  1199. rg.cleartempgen;
  1200. {$endif newra}
  1201. secondpass(left);
  1202. end;
  1203. end;
  1204. {*****************************************************************************
  1205. SecondTryFinally
  1206. *****************************************************************************}
  1207. procedure tcgtryfinallynode.pass_2;
  1208. var
  1209. reraiselabel,
  1210. finallylabel,
  1211. endfinallylabel,
  1212. exitfinallylabel,
  1213. continuefinallylabel,
  1214. breakfinallylabel,
  1215. oldaktexitlabel,
  1216. oldaktcontinuelabel,
  1217. oldaktbreaklabel : tasmlabel;
  1218. oldflowcontrol,tryflowcontrol : tflowcontrol;
  1219. decconst : longint;
  1220. tempbuf,tempaddr : treference;
  1221. href : treference;
  1222. r:Tregister;
  1223. begin
  1224. location_reset(location,LOC_VOID,OS_NO);
  1225. { check if child nodes do a break/continue/exit }
  1226. oldflowcontrol:=flowcontrol;
  1227. flowcontrol:=[];
  1228. objectlibrary.getlabel(finallylabel);
  1229. objectlibrary.getlabel(endfinallylabel);
  1230. objectlibrary.getlabel(reraiselabel);
  1231. { the finally block must catch break, continue and exit }
  1232. { statements }
  1233. oldaktexitlabel:=current_procinfo.aktexitlabel;
  1234. if implicitframe then
  1235. exitfinallylabel:=finallylabel
  1236. else
  1237. objectlibrary.getlabel(exitfinallylabel);
  1238. current_procinfo.aktexitlabel:=exitfinallylabel;
  1239. if assigned(aktbreaklabel) then
  1240. begin
  1241. oldaktcontinuelabel:=aktcontinuelabel;
  1242. oldaktbreaklabel:=aktbreaklabel;
  1243. if implicitframe then
  1244. begin
  1245. breakfinallylabel:=finallylabel;
  1246. continuefinallylabel:=finallylabel;
  1247. end
  1248. else
  1249. begin
  1250. objectlibrary.getlabel(breakfinallylabel);
  1251. objectlibrary.getlabel(continuefinallylabel);
  1252. end;
  1253. aktcontinuelabel:=continuefinallylabel;
  1254. aktbreaklabel:=breakfinallylabel;
  1255. end;
  1256. { call setjmp, and jump to finally label on non-zero result }
  1257. try_new_exception(exprasmlist,tempbuf,tempaddr,href,1,finallylabel);
  1258. { try code }
  1259. if assigned(left) then
  1260. begin
  1261. secondpass(left);
  1262. tryflowcontrol:=flowcontrol;
  1263. if codegenerror then
  1264. exit;
  1265. end;
  1266. cg.a_label(exprasmlist,finallylabel);
  1267. { just free the frame information }
  1268. try_free_exception(exprasmlist,tempbuf,tempaddr,href,1,finallylabel,true);
  1269. { finally code }
  1270. flowcontrol:=[];
  1271. secondpass(right);
  1272. if flowcontrol<>[] then
  1273. CGMessage(cg_e_control_flow_outside_finally);
  1274. if codegenerror then
  1275. exit;
  1276. { the value should now be in the exception handler }
  1277. cg.g_exception_reason_load(exprasmlist,href);
  1278. r.enum:=R_INTREGISTER;
  1279. r.number:=NR_FUNCTION_RESULT_REG;
  1280. if implicitframe then
  1281. begin
  1282. cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_EQ,0,r,endfinallylabel);
  1283. { finally code only needed to be executed on exception }
  1284. flowcontrol:=[];
  1285. secondpass(t1);
  1286. if flowcontrol<>[] then
  1287. CGMessage(cg_e_control_flow_outside_finally);
  1288. if codegenerror then
  1289. exit;
  1290. cg.a_call_name(exprasmlist,'FPC_RERAISE');
  1291. end
  1292. else
  1293. begin
  1294. cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_EQ,0,r,endfinallylabel);
  1295. cg.a_op_const_reg(exprasmlist,OP_SUB,OS_32,1,r);
  1296. cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_EQ,0,r,reraiselabel);
  1297. if fc_exit in tryflowcontrol then
  1298. begin
  1299. cg.a_op_const_reg(exprasmlist,OP_SUB,OS_32,1,r);
  1300. cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_EQ,0,r,oldaktexitlabel);
  1301. decconst:=1;
  1302. end
  1303. else
  1304. decconst:=2;
  1305. if fc_break in tryflowcontrol then
  1306. begin
  1307. cg.a_op_const_reg(exprasmlist,OP_SUB,OS_32,decconst,r);
  1308. cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_EQ,0,r,oldaktbreaklabel);
  1309. decconst:=1;
  1310. end
  1311. else
  1312. inc(decconst);
  1313. if fc_continue in tryflowcontrol then
  1314. begin
  1315. cg.a_op_const_reg(exprasmlist,OP_SUB,OS_32,decconst,r);
  1316. cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_EQ,0,r,oldaktcontinuelabel);
  1317. end;
  1318. cg.a_label(exprasmlist,reraiselabel);
  1319. cg.a_call_name(exprasmlist,'FPC_RERAISE');
  1320. { do some magic for exit,break,continue in the try block }
  1321. if fc_exit in tryflowcontrol then
  1322. begin
  1323. cg.a_label(exprasmlist,exitfinallylabel);
  1324. cg.g_exception_reason_load(exprasmlist,href);
  1325. cg.g_exception_reason_save_const(exprasmlist,href,2);
  1326. cg.a_jmp_always(exprasmlist,finallylabel);
  1327. end;
  1328. if fc_break in tryflowcontrol then
  1329. begin
  1330. cg.a_label(exprasmlist,breakfinallylabel);
  1331. cg.g_exception_reason_load(exprasmlist,href);
  1332. cg.g_exception_reason_save_const(exprasmlist,href,3);
  1333. cg.a_jmp_always(exprasmlist,finallylabel);
  1334. end;
  1335. if fc_continue in tryflowcontrol then
  1336. begin
  1337. cg.a_label(exprasmlist,continuefinallylabel);
  1338. cg.g_exception_reason_load(exprasmlist,href);
  1339. cg.g_exception_reason_save_const(exprasmlist,href,4);
  1340. cg.a_jmp_always(exprasmlist,finallylabel);
  1341. end;
  1342. end;
  1343. cg.a_label(exprasmlist,endfinallylabel);
  1344. current_procinfo.aktexitlabel:=oldaktexitlabel;
  1345. if assigned(aktbreaklabel) then
  1346. begin
  1347. aktcontinuelabel:=oldaktcontinuelabel;
  1348. aktbreaklabel:=oldaktbreaklabel;
  1349. end;
  1350. flowcontrol:=oldflowcontrol+tryflowcontrol;
  1351. end;
  1352. begin
  1353. cwhilerepeatnode:=tcgwhilerepeatnode;
  1354. cifnode:=tcgifnode;
  1355. cfornode:=tcgfornode;
  1356. cexitnode:=tcgexitnode;
  1357. cbreaknode:=tcgbreaknode;
  1358. ccontinuenode:=tcgcontinuenode;
  1359. cgotonode:=tcggotonode;
  1360. clabelnode:=tcglabelnode;
  1361. craisenode:=tcgraisenode;
  1362. ctryexceptnode:=tcgtryexceptnode;
  1363. ctryfinallynode:=tcgtryfinallynode;
  1364. connode:=tcgonnode;
  1365. end.
  1366. {
  1367. $Log$
  1368. Revision 1.76 2003-08-24 21:38:43 olle
  1369. * made FPC_RAISEEXCEPTION compatible with MacOS
  1370. Revision 1.75 2003/08/10 17:25:23 peter
  1371. * fixed some reported bugs
  1372. Revision 1.74 2003/08/09 18:56:54 daniel
  1373. * cs_regalloc renamed to cs_regvars to avoid confusion with register
  1374. allocator
  1375. * Some preventive changes to i386 spillinh code
  1376. Revision 1.73 2003/07/23 11:01:14 jonas
  1377. * several rg.allocexplicitregistersint/rg.deallocexplicitregistersint
  1378. pairs round calls to helpers
  1379. Revision 1.72 2003/06/13 21:19:30 peter
  1380. * current_procdef removed, use current_procinfo.procdef instead
  1381. Revision 1.71 2003/06/09 14:38:52 jonas
  1382. * fixed for callparatemp
  1383. Revision 1.70 2003/06/09 12:23:30 peter
  1384. * init/final of procedure data splitted from genentrycode
  1385. * use asmnode getposition to insert final at the correct position
  1386. als for the implicit try...finally
  1387. Revision 1.69 2003/06/07 18:57:04 jonas
  1388. + added freeintparaloc
  1389. * ppc get/freeintparaloc now check whether the parameter regs are
  1390. properly allocated/deallocated (and get an extra list para)
  1391. * ppc a_call_* now internalerrors if pi_do_call is not yet set
  1392. * fixed lot of missing pi_do_call's
  1393. Revision 1.68 2003/06/03 21:11:09 peter
  1394. * cg.a_load_* get a from and to size specifier
  1395. * makeregsize only accepts newregister
  1396. * i386 uses generic tcgnotnode,tcgunaryminus
  1397. Revision 1.67 2003/06/01 21:38:06 peter
  1398. * getregisterfpu size parameter added
  1399. * op_const_reg size parameter added
  1400. * sparc updates
  1401. Revision 1.66 2003/05/30 23:57:08 peter
  1402. * more sparc cleanup
  1403. * accumulator removed, splitted in function_return_reg (called) and
  1404. function_result_reg (caller)
  1405. Revision 1.65 2003/05/30 18:55:21 jonas
  1406. * fixed several regvar related bugs for non-i386. make cycle with -Or now
  1407. works for ppc
  1408. Revision 1.64 2003/05/26 21:17:17 peter
  1409. * procinlinenode removed
  1410. * aktexit2label removed, fast exit removed
  1411. + tcallnode.inlined_pass_2 added
  1412. Revision 1.63 2003/05/23 14:27:35 peter
  1413. * remove some unit dependencies
  1414. * current_procinfo changes to store more info
  1415. Revision 1.62 2003/05/17 13:30:08 jonas
  1416. * changed tt_persistant to tt_persistent :)
  1417. * tempcreatenode now doesn't accept a boolean anymore for persistent
  1418. temps, but a ttemptype, so you can also create ansistring temps etc
  1419. Revision 1.61 2003/05/16 14:33:31 peter
  1420. * regvar fixes
  1421. Revision 1.60 2003/05/13 19:14:41 peter
  1422. * failn removed
  1423. * inherited result code check moven to pexpr
  1424. Revision 1.59 2003/05/11 21:37:03 peter
  1425. * moved implicit exception frame from ncgutil to psub
  1426. * constructor/destructor helpers moved from cobj/ncgutil to psub
  1427. Revision 1.58 2003/04/30 15:45:35 florian
  1428. * merged more x86-64/i386 code
  1429. Revision 1.57 2003/04/29 07:29:14 michael
  1430. + Patch from peter to fix wrong pushing of ansistring function results in open array
  1431. Revision 1.56 2003/04/27 11:21:33 peter
  1432. * aktprocdef renamed to current_procinfo.procdef
  1433. * procinfo renamed to current_procinfo
  1434. * procinfo will now be stored in current_module so it can be
  1435. cleaned up properly
  1436. * gen_main_procsym changed to create_main_proc and release_main_proc
  1437. to also generate a tprocinfo structure
  1438. * fixed unit implicit initfinal
  1439. Revision 1.55 2003/04/22 23:50:22 peter
  1440. * firstpass uses expectloc
  1441. * checks if there are differences between the expectloc and
  1442. location.loc from secondpass in EXTDEBUG
  1443. Revision 1.54 2003/04/17 07:50:24 daniel
  1444. * Some work on interference graph construction
  1445. Revision 1.53 2003/04/06 21:11:23 olle
  1446. * changed newasmsymbol to newasmsymboldata for data symbols
  1447. Revision 1.52 2003/03/28 19:16:56 peter
  1448. * generic constructor working for i386
  1449. * remove fixed self register
  1450. * esi added as address register for i386
  1451. Revision 1.51 2003/02/19 22:00:14 daniel
  1452. * Code generator converted to new register notation
  1453. - Horribily outdated todo.txt removed
  1454. Revision 1.50 2003/02/15 22:17:38 carl
  1455. * bugfix of FPU emulation code
  1456. Revision 1.49 2003/01/08 18:43:56 daniel
  1457. * Tregister changed into a record
  1458. Revision 1.48 2003/01/03 09:51:58 daniel
  1459. * Compiler now cycles with var_notification
  1460. Revision 1.47 2003/01/02 15:29:25 daniel
  1461. * Some debugging on for loop optimization
  1462. Revision 1.46 2002/12/31 09:55:58 daniel
  1463. + Notification implementation complete
  1464. + Add for loop code optimization using notifications
  1465. results in 1.5-1.9% speed improvement in nestloop benchmark
  1466. Optimization incomplete, compiler does not cycle yet with
  1467. notifications enabled.
  1468. Revision 1.45 2002/11/28 11:17:01 florian
  1469. * loop node flags from node flags splitted
  1470. Revision 1.44 2002/11/25 17:43:17 peter
  1471. * splitted defbase in defutil,symutil,defcmp
  1472. * merged isconvertable and is_equal into compare_defs(_ext)
  1473. * made operator search faster by walking the list only once
  1474. Revision 1.43 2002/09/30 07:00:45 florian
  1475. * fixes to common code to get the alpha compiler compiled applied
  1476. Revision 1.42 2002/09/07 15:25:02 peter
  1477. * old logs removed and tabs fixed
  1478. Revision 1.41 2002/09/01 18:47:00 peter
  1479. * assignn check in exitnode changed to use a separate boolean as the
  1480. assignn can be changed to a calln
  1481. Revision 1.40 2002/09/01 14:41:47 peter
  1482. * increase refcount in exit(arg) for arg
  1483. Revision 1.39 2002/08/24 18:41:52 peter
  1484. * fixed wrong label in jump of except block (was also in n386flw wrong)
  1485. * fixed wrong pushing of raise parameters
  1486. * fixed wrong compare in finally
  1487. Revision 1.38 2002/08/23 16:14:48 peter
  1488. * tempgen cleanup
  1489. * tt_noreuse temp type added that will be used in genentrycode
  1490. Revision 1.37 2002/08/19 19:36:43 peter
  1491. * More fixes for cross unit inlining, all tnodes are now implemented
  1492. * Moved pocall_internconst to po_internconst because it is not a
  1493. calling type at all and it conflicted when inlining of these small
  1494. functions was requested
  1495. Revision 1.36 2002/08/15 15:15:55 carl
  1496. * jmpbuf size allocation for exceptions is now cpu specific (as it should)
  1497. * more generic nodes for maths
  1498. * several fixes for better m68k support
  1499. Revision 1.35 2002/08/13 18:01:52 carl
  1500. * rename swatoperands to swapoperands
  1501. + m68k first compilable version (still needs a lot of testing):
  1502. assembler generator, system information , inline
  1503. assembler reader.
  1504. Revision 1.34 2002/08/11 14:32:26 peter
  1505. * renamed current_library to objectlibrary
  1506. Revision 1.33 2002/08/11 13:24:11 peter
  1507. * saving of asmsymbols in ppu supported
  1508. * asmsymbollist global is removed and moved into a new class
  1509. tasmlibrarydata that will hold the info of a .a file which
  1510. corresponds with a single module. Added librarydata to tmodule
  1511. to keep the library info stored for the module. In the future the
  1512. objectfiles will also be stored to the tasmlibrarydata class
  1513. * all getlabel/newasmsymbol and friends are moved to the new class
  1514. Revision 1.32 2002/08/09 19:10:59 carl
  1515. * fixed generic exception management
  1516. Revision 1.31 2002/08/04 19:06:41 carl
  1517. + added generic exception support (still does not work!)
  1518. + more documentation
  1519. Revision 1.30 2002/07/27 19:53:51 jonas
  1520. + generic implementation of tcg.g_flags2ref()
  1521. * tcg.flags2xxx() now also needs a size parameter
  1522. Revision 1.29 2002/07/25 17:56:29 carl
  1523. + FPURESULTREG -> FPU_RESULT_REG
  1524. Revision 1.28 2002/07/21 06:58:49 daniel
  1525. * Changed booleans into flags
  1526. Revision 1.27 2002/07/20 12:54:53 daniel
  1527. * Optimized the code generated for for nodes. The shootout/nestloop benchmark
  1528. now runs 5% faster on my computer.
  1529. Revision 1.26 2002/07/20 11:57:54 florian
  1530. * types.pas renamed to defbase.pas because D6 contains a types
  1531. unit so this would conflicts if D6 programms are compiled
  1532. + Willamette/SSE2 instructions to assembler added
  1533. Revision 1.25 2002/07/20 11:15:51 daniel
  1534. * The for node does a check if the first comparision can be skipped. I moved
  1535. the check from the second pass to the resulttype pass. The advantage is
  1536. that the state tracker can now decide to skip the first comparision too.
  1537. Revision 1.24 2002/07/20 08:14:24 daniel
  1538. * Loops should not be aligned when optimizing for size
  1539. Revision 1.23 2002/07/19 11:41:35 daniel
  1540. * State tracker work
  1541. * The whilen and repeatn are now completely unified into whilerepeatn. This
  1542. allows the state tracker to change while nodes automatically into
  1543. repeat nodes.
  1544. * Resulttypepass improvements to the notn. 'not not a' is optimized away and
  1545. 'not(a>b)' is optimized into 'a<=b'.
  1546. * Resulttypepass improvements to the whilerepeatn. 'while not a' is optimized
  1547. by removing the notn and later switchting the true and falselabels. The
  1548. same is done with 'repeat until not a'.
  1549. Revision 1.22 2002/07/04 20:43:01 florian
  1550. * first x86-64 patches
  1551. }