cg386flw.pas 27 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817
  1. {
  2. $Id$
  3. Copyright (c) 1993-98 by Florian Klaempfl
  4. Generate i386 assembler for nodes that influence the flow
  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 cg386flw;
  19. interface
  20. uses
  21. tree;
  22. procedure second_while_repeatn(var p : ptree);
  23. procedure secondifn(var p : ptree);
  24. procedure secondfor(var p : ptree);
  25. procedure secondexitn(var p : ptree);
  26. procedure secondbreakn(var p : ptree);
  27. procedure secondcontinuen(var p : ptree);
  28. procedure secondgoto(var p : ptree);
  29. procedure secondlabel(var p : ptree);
  30. procedure secondraise(var p : ptree);
  31. procedure secondtryexcept(var p : ptree);
  32. procedure secondtryfinally(var p : ptree);
  33. procedure secondon(var p : ptree);
  34. procedure secondfail(var p : ptree);
  35. implementation
  36. uses
  37. cobjects,verbose,globals,systems,
  38. symtable,aasm,types,
  39. hcodegen,temp_gen,pass_2,
  40. i386,cgai386,tgeni386;
  41. {*****************************************************************************
  42. Second_While_RepeatN
  43. *****************************************************************************}
  44. procedure second_while_repeatn(var p : ptree);
  45. var
  46. lcont,lbreak,lloop,
  47. oldclabel,oldblabel : plabel;
  48. otlabel,oflabel : plabel;
  49. begin
  50. getlabel(lloop);
  51. getlabel(lcont);
  52. getlabel(lbreak);
  53. { arrange continue and breaklabels: }
  54. oldclabel:=aktcontinuelabel;
  55. oldblabel:=aktbreaklabel;
  56. { handling code at the end as it is much more efficient, and makes
  57. while equal to repeat loop, only the end true/false is swapped (PFV) }
  58. if p^.treetype=whilen then
  59. emitl(A_JMP,lcont);
  60. emitl(A_LABEL,lloop);
  61. aktcontinuelabel:=lcont;
  62. aktbreaklabel:=lbreak;
  63. cleartempgen;
  64. if assigned(p^.right) then
  65. secondpass(p^.right);
  66. emitl(A_LABEL,lcont);
  67. otlabel:=truelabel;
  68. oflabel:=falselabel;
  69. if p^.treetype=whilen then
  70. begin
  71. truelabel:=lloop;
  72. falselabel:=lbreak;
  73. end
  74. { repeatn }
  75. else
  76. begin
  77. truelabel:=lbreak;
  78. falselabel:=lloop;
  79. end;
  80. cleartempgen;
  81. secondpass(p^.left);
  82. maketojumpbool(p^.left);
  83. emitl(A_LABEL,lbreak);
  84. freelabel(lloop);
  85. freelabel(lcont);
  86. freelabel(lbreak);
  87. truelabel:=otlabel;
  88. falselabel:=oflabel;
  89. aktcontinuelabel:=oldclabel;
  90. aktbreaklabel:=oldblabel;
  91. end;
  92. {*****************************************************************************
  93. SecondIfN
  94. *****************************************************************************}
  95. procedure secondifn(var p : ptree);
  96. var
  97. hl,otlabel,oflabel : plabel;
  98. begin
  99. otlabel:=truelabel;
  100. oflabel:=falselabel;
  101. getlabel(truelabel);
  102. getlabel(falselabel);
  103. cleartempgen;
  104. secondpass(p^.left);
  105. maketojumpbool(p^.left);
  106. if assigned(p^.right) then
  107. begin
  108. emitl(A_LABEL,truelabel);
  109. cleartempgen;
  110. secondpass(p^.right);
  111. end;
  112. if assigned(p^.t1) then
  113. begin
  114. if assigned(p^.right) then
  115. begin
  116. getlabel(hl);
  117. { do go back to if line !! }
  118. aktfilepos:=exprasmlist^.getlasttaifilepos^;
  119. emitl(A_JMP,hl);
  120. end;
  121. emitl(A_LABEL,falselabel);
  122. cleartempgen;
  123. secondpass(p^.t1);
  124. if assigned(p^.right) then
  125. emitl(A_LABEL,hl);
  126. end
  127. else
  128. emitl(A_LABEL,falselabel);
  129. if not(assigned(p^.right)) then
  130. emitl(A_LABEL,truelabel);
  131. freelabel(truelabel);
  132. freelabel(falselabel);
  133. truelabel:=otlabel;
  134. falselabel:=oflabel;
  135. end;
  136. {*****************************************************************************
  137. SecondFor
  138. *****************************************************************************}
  139. procedure secondfor(var p : ptree);
  140. var
  141. l3,oldclabel,oldblabel : plabel;
  142. omitfirstcomp,temptovalue : boolean;
  143. hs : byte;
  144. temp1 : treference;
  145. hop : tasmop;
  146. cmpreg,cmp32 : tregister;
  147. opsize : topsize;
  148. count_var_is_signed : boolean;
  149. begin
  150. oldclabel:=aktcontinuelabel;
  151. oldblabel:=aktbreaklabel;
  152. getlabel(aktcontinuelabel);
  153. getlabel(aktbreaklabel);
  154. getlabel(l3);
  155. { could we spare the first comparison ? }
  156. omitfirstcomp:=false;
  157. if p^.right^.treetype=ordconstn then
  158. if p^.left^.right^.treetype=ordconstn then
  159. omitfirstcomp:=(p^.backward and (p^.left^.right^.value>=p^.right^.value))
  160. or (not(p^.backward) and (p^.left^.right^.value<=p^.right^.value));
  161. { only calculate reference }
  162. cleartempgen;
  163. secondpass(p^.t2);
  164. if not(simple_loadn) then
  165. CGMessage(cg_e_illegal_count_var);
  166. { produce start assignment }
  167. cleartempgen;
  168. secondpass(p^.left);
  169. count_var_is_signed:=is_signed(porddef(p^.t2^.resulttype));
  170. hs:=p^.t2^.resulttype^.size;
  171. cmp32:=getregister32;
  172. case hs of
  173. 1 : begin
  174. opsize:=S_B;
  175. cmpreg:=reg32toreg8(cmp32);
  176. end;
  177. 2 : begin
  178. opsize:=S_W;
  179. cmpreg:=reg32toreg16(cmp32);
  180. end;
  181. 4 : begin
  182. opsize:=S_L;
  183. cmpreg:=cmp32;
  184. end;
  185. end;
  186. cleartempgen;
  187. secondpass(p^.right);
  188. { calculate pointer value and check if changeable and if so }
  189. { load into temporary variable }
  190. if p^.right^.treetype<>ordconstn then
  191. begin
  192. temp1.symbol:=nil;
  193. gettempofsizereference(hs,temp1);
  194. temptovalue:=true;
  195. if (p^.right^.location.loc=LOC_REGISTER) or
  196. (p^.right^.location.loc=LOC_CREGISTER) then
  197. begin
  198. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,opsize,p^.right^.location.register,
  199. newreference(temp1))));
  200. end
  201. else
  202. concatcopy(p^.right^.location.reference,temp1,hs,false);
  203. end
  204. else temptovalue:=false;
  205. if temptovalue then
  206. begin
  207. if p^.t2^.location.loc=LOC_CREGISTER then
  208. begin
  209. exprasmlist^.concat(new(pai386,op_ref_reg(A_CMP,opsize,newreference(temp1),
  210. p^.t2^.location.register)));
  211. end
  212. else
  213. begin
  214. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,newreference(p^.t2^.location.reference),
  215. cmpreg)));
  216. exprasmlist^.concat(new(pai386,op_ref_reg(A_CMP,opsize,newreference(temp1),
  217. cmpreg)));
  218. end;
  219. end
  220. else
  221. begin
  222. if not(omitfirstcomp) then
  223. begin
  224. if p^.t2^.location.loc=LOC_CREGISTER then
  225. exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,p^.right^.value,
  226. p^.t2^.location.register)))
  227. else
  228. exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,opsize,p^.right^.value,
  229. newreference(p^.t2^.location.reference))));
  230. end;
  231. end;
  232. if p^.backward then
  233. if count_var_is_signed then
  234. hop:=A_JL
  235. else hop:=A_JB
  236. else
  237. if count_var_is_signed then
  238. hop:=A_JG
  239. else hop:=A_JA;
  240. if not(omitfirstcomp) or temptovalue then
  241. emitl(hop,aktbreaklabel);
  242. emitl(A_LABEL,l3);
  243. { help register must not be in instruction block }
  244. cleartempgen;
  245. if assigned(p^.t1) then
  246. secondpass(p^.t1);
  247. emitl(A_LABEL,aktcontinuelabel);
  248. { makes no problems there }
  249. cleartempgen;
  250. { demand help register again }
  251. cmp32:=getregister32;
  252. case hs of
  253. 1 : begin
  254. opsize:=S_B;
  255. cmpreg:=reg32toreg8(cmp32);
  256. end;
  257. 2 : begin
  258. opsize:=S_W;
  259. cmpreg:=reg32toreg16(cmp32);
  260. end;
  261. 4 : opsize:=S_L;
  262. end;
  263. { produce comparison and the corresponding }
  264. { jump }
  265. if temptovalue then
  266. begin
  267. if p^.t2^.location.loc=LOC_CREGISTER then
  268. begin
  269. exprasmlist^.concat(new(pai386,op_ref_reg(A_CMP,opsize,newreference(temp1),
  270. p^.t2^.location.register)));
  271. end
  272. else
  273. begin
  274. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,newreference(p^.t2^.location.reference),
  275. cmpreg)));
  276. exprasmlist^.concat(new(pai386,op_ref_reg(A_CMP,opsize,newreference(temp1),
  277. cmpreg)));
  278. end;
  279. end
  280. else
  281. begin
  282. if p^.t2^.location.loc=LOC_CREGISTER then
  283. exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,p^.right^.value,
  284. p^.t2^.location.register)))
  285. else
  286. exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,opsize,p^.right^.value,
  287. newreference(p^.t2^.location.reference))));
  288. end;
  289. if p^.backward then
  290. if count_var_is_signed then
  291. hop:=A_JLE
  292. else
  293. hop :=A_JBE
  294. else
  295. if count_var_is_signed then
  296. hop:=A_JGE
  297. else
  298. hop:=A_JAE;
  299. emitl(hop,aktbreaklabel);
  300. { according to count direction DEC or INC... }
  301. { must be after the test because of 0to 255 for bytes !! }
  302. if p^.backward then
  303. hop:=A_DEC
  304. else hop:=A_INC;
  305. if p^.t2^.location.loc=LOC_CREGISTER then
  306. exprasmlist^.concat(new(pai386,op_reg(hop,opsize,p^.t2^.location.register)))
  307. else
  308. exprasmlist^.concat(new(pai386,op_ref(hop,opsize,newreference(p^.t2^.location.reference))));
  309. emitl(A_JMP,l3);
  310. { this is the break label: }
  311. emitl(A_LABEL,aktbreaklabel);
  312. ungetregister32(cmp32);
  313. if temptovalue then
  314. ungetiftemp(temp1);
  315. freelabel(aktcontinuelabel);
  316. freelabel(aktbreaklabel);
  317. freelabel(l3);
  318. aktcontinuelabel:=oldclabel;
  319. aktbreaklabel:=oldblabel;
  320. end;
  321. {*****************************************************************************
  322. SecondExitN
  323. *****************************************************************************}
  324. procedure secondexitn(var p : ptree);
  325. var
  326. is_mem : boolean;
  327. {op : tasmop;
  328. s : topsize;}
  329. otlabel,oflabel : plabel;
  330. label
  331. do_jmp;
  332. begin
  333. if assigned(p^.left) then
  334. begin
  335. otlabel:=truelabel;
  336. oflabel:=falselabel;
  337. getlabel(truelabel);
  338. getlabel(falselabel);
  339. secondpass(p^.left);
  340. case p^.left^.location.loc of
  341. LOC_FPU : goto do_jmp;
  342. LOC_MEM,
  343. LOC_REFERENCE : is_mem:=true;
  344. LOC_CREGISTER,
  345. LOC_REGISTER : is_mem:=false;
  346. LOC_FLAGS : begin
  347. exprasmlist^.concat(new(pai386,op_reg(flag_2_set[p^.right^.location.resflags],S_B,R_AL)));
  348. goto do_jmp;
  349. end;
  350. LOC_JUMP : begin
  351. emitl(A_LABEL,truelabel);
  352. exprasmlist^.concat(new(pai386,op_const_reg(A_MOV,S_B,1,R_AL)));
  353. emitl(A_JMP,aktexit2label);
  354. exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_B,R_AL,R_AL)));
  355. goto do_jmp;
  356. end;
  357. else
  358. internalerror(2001);
  359. end;
  360. case procinfo.retdef^.deftype of
  361. orddef,
  362. enumdef : begin
  363. case procinfo.retdef^.size of
  364. 4 : if is_mem then
  365. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  366. newreference(p^.left^.location.reference),R_EAX)))
  367. else
  368. emit_reg_reg(A_MOV,S_L,p^.left^.location.register,R_EAX);
  369. 2 : if is_mem then
  370. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_W,
  371. newreference(p^.left^.location.reference),R_AX)))
  372. else
  373. emit_reg_reg(A_MOV,S_W,p^.left^.location.register,R_AX);
  374. 1 : if is_mem then
  375. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_B,
  376. newreference(p^.left^.location.reference),R_AL)))
  377. else
  378. emit_reg_reg(A_MOV,S_B,p^.left^.location.register,R_AL);
  379. end;
  380. end;
  381. pointerdef,
  382. procvardef : begin
  383. if is_mem then
  384. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  385. newreference(p^.left^.location.reference),R_EAX)))
  386. else
  387. exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_L,
  388. p^.left^.location.register,R_EAX)));
  389. end;
  390. floatdef : begin
  391. if pfloatdef(procinfo.retdef)^.typ=f32bit then
  392. begin
  393. if is_mem then
  394. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  395. newreference(p^.left^.location.reference),R_EAX)))
  396. else
  397. emit_reg_reg(A_MOV,S_L,p^.left^.location.register,R_EAX);
  398. end
  399. else
  400. if is_mem then
  401. floatload(pfloatdef(procinfo.retdef)^.typ,p^.left^.location.reference);
  402. end;
  403. end;
  404. do_jmp:
  405. freelabel(truelabel);
  406. freelabel(falselabel);
  407. truelabel:=otlabel;
  408. falselabel:=oflabel;
  409. emitl(A_JMP,aktexit2label);
  410. end
  411. else
  412. begin
  413. emitl(A_JMP,aktexitlabel);
  414. end;
  415. end;
  416. {*****************************************************************************
  417. SecondBreakN
  418. *****************************************************************************}
  419. procedure secondbreakn(var p : ptree);
  420. begin
  421. if aktbreaklabel<>nil then
  422. emitl(A_JMP,aktbreaklabel)
  423. else
  424. CGMessage(cg_e_break_not_allowed);
  425. end;
  426. {*****************************************************************************
  427. SecondContinueN
  428. *****************************************************************************}
  429. procedure secondcontinuen(var p : ptree);
  430. begin
  431. if aktcontinuelabel<>nil then
  432. emitl(A_JMP,aktcontinuelabel)
  433. else
  434. CGMessage(cg_e_continue_not_allowed);
  435. end;
  436. {*****************************************************************************
  437. SecondGoto
  438. *****************************************************************************}
  439. procedure secondgoto(var p : ptree);
  440. begin
  441. emitl(A_JMP,p^.labelnr);
  442. end;
  443. {*****************************************************************************
  444. SecondLabel
  445. *****************************************************************************}
  446. procedure secondlabel(var p : ptree);
  447. begin
  448. emitl(A_LABEL,p^.labelnr);
  449. cleartempgen;
  450. secondpass(p^.left);
  451. end;
  452. {*****************************************************************************
  453. SecondRaise
  454. *****************************************************************************}
  455. procedure secondraise(var p : ptree);
  456. var
  457. a : plabel;
  458. begin
  459. if assigned(p^.left) then
  460. begin
  461. { generate the address }
  462. if assigned(p^.right) then
  463. begin
  464. secondpass(p^.right);
  465. if codegenerror then
  466. exit;
  467. end
  468. else
  469. begin
  470. getlabel(a);
  471. emitl(A_LABEL,a);
  472. exprasmlist^.concat(new(pai386,
  473. op_csymbol(A_PUSH,S_L,newcsymbol(lab2str(a),0))));
  474. end;
  475. secondpass(p^.left);
  476. if codegenerror then
  477. exit;
  478. case p^.left^.location.loc of
  479. LOC_MEM,LOC_REFERENCE:
  480. exprasmlist^.concat(new(pai386,op_ref(A_PUSH,S_L,
  481. newreference(p^.left^.location.reference))));
  482. LOC_CREGISTER,LOC_REGISTER : exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,
  483. p^.left^.location.register)));
  484. else CGMessage(type_e_mismatch);
  485. end;
  486. emitcall('FPC_RAISEEXCEPTION',true);
  487. end
  488. else
  489. begin
  490. emitcall('FPC_RERAISE',true);
  491. end;
  492. end;
  493. {*****************************************************************************
  494. SecondTryExcept
  495. *****************************************************************************}
  496. var
  497. endexceptlabel : plabel;
  498. procedure secondtryexcept(var p : ptree);
  499. var
  500. exceptlabel,doexceptlabel,oldendexceptlabel,
  501. lastonlabel : plabel;
  502. begin
  503. { this can be called recursivly }
  504. oldendexceptlabel:=endexceptlabel;
  505. { we modify EAX }
  506. usedinproc:=usedinproc or ($80 shr byte(R_EAX));
  507. getlabel(exceptlabel);
  508. getlabel(doexceptlabel);
  509. getlabel(endexceptlabel);
  510. getlabel(lastonlabel);
  511. push_int (1); { push type of exceptionframe }
  512. emitcall('FPC_PUSHEXCEPTADDR',true);
  513. exprasmlist^.concat(new(pai386,
  514. op_reg(A_PUSH,S_L,R_EAX)));
  515. emitcall('FPC_SETJMP',true);
  516. exprasmlist^.concat(new(pai386,
  517. op_reg(A_PUSH,S_L,R_EAX)));
  518. exprasmlist^.concat(new(pai386,
  519. op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)));
  520. emitl(A_JNE,exceptlabel);
  521. { try code }
  522. secondpass(p^.left);
  523. if codegenerror then
  524. exit;
  525. emitl(A_LABEL,exceptlabel);
  526. exprasmlist^.concat(new(pai386,
  527. op_reg(A_POP,S_L,R_EAX)));
  528. exprasmlist^.concat(new(pai386,
  529. op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)));
  530. emitl(A_JNE,doexceptlabel);
  531. emitcall('FPC_POPADDRSTACK',true);
  532. emitl(A_JMP,endexceptlabel);
  533. emitl(A_LABEL,doexceptlabel);
  534. if assigned(p^.right) then
  535. secondpass(p^.right);
  536. emitl(A_LABEL,lastonlabel);
  537. { default handling }
  538. if assigned(p^.t1) then
  539. begin
  540. { FPC_CATCHES must be called with
  541. 'default handler' flag (=-1)
  542. }
  543. push_int (-1);
  544. emitcall('FPC_CATCHES',true);
  545. secondpass(p^.t1);
  546. end
  547. else
  548. emitcall('FPC_RERAISE',true);
  549. emitl(A_LABEL,endexceptlabel);
  550. freelabel(exceptlabel);
  551. freelabel(doexceptlabel);
  552. freelabel(endexceptlabel);
  553. freelabel(lastonlabel);
  554. endexceptlabel:=oldendexceptlabel;
  555. end;
  556. procedure secondon(var p : ptree);
  557. var
  558. nextonlabel : plabel;
  559. ref : treference;
  560. begin
  561. getlabel(nextonlabel);
  562. { push the vmt }
  563. exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,
  564. newcsymbol(p^.excepttype^.vmt_mangledname,0))));
  565. maybe_concat_external(p^.excepttype^.owner,
  566. p^.excepttype^.vmt_mangledname);
  567. emitcall('FPC_CATCHES',true);
  568. exprasmlist^.concat(new(pai386,
  569. op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)));
  570. emitl(A_JE,nextonlabel);
  571. ref.symbol:=nil;
  572. gettempofsizereference(4,ref);
  573. { what a hack ! }
  574. if assigned(p^.exceptsymtable) then
  575. pvarsym(p^.exceptsymtable^.root)^.address:=ref.offset;
  576. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
  577. R_EAX,newreference(ref))));
  578. if assigned(p^.right) then
  579. secondpass(p^.right);
  580. { clear some stuff }
  581. ungetiftemp(ref);
  582. emitl(A_JMP,endexceptlabel);
  583. emitl(A_LABEL,nextonlabel);
  584. { next on node }
  585. if assigned(p^.left) then
  586. secondpass(p^.left);
  587. end;
  588. {*****************************************************************************
  589. SecondTryFinally
  590. *****************************************************************************}
  591. procedure secondtryfinally(var p : ptree);
  592. var
  593. finallylabel,noreraiselabel,endfinallylabel : plabel;
  594. begin
  595. { we modify EAX }
  596. usedinproc:=usedinproc or ($80 shr byte(R_EAX));
  597. getlabel(finallylabel);
  598. getlabel(noreraiselabel);
  599. getlabel(endfinallylabel);
  600. push_int(1); { Type of stack-frame must be pushed}
  601. emitcall('FPC_PUSHEXCEPTADDR',true);
  602. exprasmlist^.concat(new(pai386,
  603. op_reg(A_PUSH,S_L,R_EAX)));
  604. emitcall('FPC_SETJMP',true);
  605. exprasmlist^.concat(new(pai386,
  606. op_reg(A_PUSH,S_L,R_EAX)));
  607. exprasmlist^.concat(new(pai386,
  608. op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)));
  609. emitl(A_JNE,finallylabel);
  610. { try code }
  611. secondpass(p^.left);
  612. if codegenerror then
  613. exit;
  614. emitl(A_LABEL,finallylabel);
  615. { finally code }
  616. secondpass(p^.right);
  617. if codegenerror then
  618. exit;
  619. exprasmlist^.concat(new(pai386,
  620. op_reg(A_POP,S_L,R_EAX)));
  621. exprasmlist^.concat(new(pai386,
  622. op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)));
  623. emitl(A_JE,noreraiselabel);
  624. emitcall('FPC_RERAISE',true);
  625. emitl(A_LABEL,noreraiselabel);
  626. emitcall('FPC_POPADDRSTACK',true);
  627. emitl(A_LABEL,endfinallylabel);
  628. end;
  629. {*****************************************************************************
  630. SecondFail
  631. *****************************************************************************}
  632. procedure secondfail(var p : ptree);
  633. var
  634. hp : preference;
  635. begin
  636. exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_L,R_ESI,R_ESI)));
  637. { also reset to zero in the stack }
  638. new(hp);
  639. reset_reference(hp^);
  640. hp^.offset:=procinfo.ESI_offset;
  641. hp^.base:=procinfo.framepointer;
  642. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_ESI,hp)));
  643. exprasmlist^.concat(new(pai_labeled,init(A_JMP,quickexitlabel)));
  644. end;
  645. end.
  646. {
  647. $Log$
  648. Revision 1.21 1998-10-26 22:58:16 florian
  649. * new introduded problem with classes fix, the parent class wasn't set
  650. correct, if the class was defined forward before
  651. Revision 1.20 1998/10/06 17:16:42 pierre
  652. * some memory leaks fixed (thanks to Peter for heaptrc !)
  653. Revision 1.19 1998/09/28 12:13:53 peter
  654. * fixed repeat continue until true;
  655. Revision 1.18 1998/09/26 15:03:04 florian
  656. * small problems with DOM and excpetions fixed (code generation
  657. of raise was wrong and self was sometimes destroyed :()
  658. Revision 1.17 1998/09/17 09:42:14 peter
  659. + pass_2 for cg386
  660. * Message() -> CGMessage() for pass_1/pass_2
  661. Revision 1.16 1998/09/14 10:43:48 peter
  662. * all internal RTL functions start with FPC_
  663. Revision 1.15 1998/09/04 08:41:39 peter
  664. * updated some error CGMessages
  665. Revision 1.14 1998/09/03 17:08:39 pierre
  666. * better lines for stabs
  667. (no scroll back to if before else part
  668. no return to case line at jump outside case)
  669. + source lines also if not in order
  670. Revision 1.13 1998/09/01 12:47:58 peter
  671. * use pdef^.size instead of orddef^.typ
  672. Revision 1.12 1998/08/28 10:56:58 peter
  673. * removed warnings
  674. Revision 1.11 1998/08/05 16:00:10 florian
  675. * some fixes for ansi strings
  676. Revision 1.10 1998/08/04 16:26:26 jonas
  677. * converted // comment to TP comment
  678. Revision 1.9 1998/07/31 11:36:34 michael
  679. Default exception handler also needs to call FPC_CATCHES
  680. Revision 1.8 1998/07/30 13:30:32 florian
  681. * final implemenation of exception support, maybe it needs
  682. some fixes :)
  683. Revision 1.7 1998/07/30 11:18:13 florian
  684. + first implementation of try ... except on .. do end;
  685. * limitiation of 65535 bytes parameters for cdecl removed
  686. Revision 1.6 1998/07/29 13:29:11 michael
  687. + Corrected try.. code. Type of exception fram is pushed
  688. Revision 1.5 1998/07/28 21:52:49 florian
  689. + implementation of raise and try..finally
  690. + some misc. exception stuff
  691. Revision 1.4 1998/07/24 22:16:53 florian
  692. * internal error 10 together with array access fixed. I hope
  693. that's the final fix.
  694. Revision 1.3 1998/06/25 08:48:08 florian
  695. * first version of rtti support
  696. Revision 1.2 1998/06/08 13:13:33 pierre
  697. + temporary variables now in temp_gen.pas unit
  698. because it is processor independent
  699. * mppc68k.bat modified to undefine i386 and support_mmx
  700. (which are defaults for i386)
  701. Revision 1.1 1998/06/05 17:44:12 peter
  702. * splitted cgi386
  703. }