cg386flw.pas 27 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856
  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,globtype,globals,systems,
  38. symconst,symtable,aasm,types,
  39. hcodegen,temp_gen,pass_2,
  40. cpubase,cpuasm,
  41. cgai386,tgeni386;
  42. {*****************************************************************************
  43. Second_While_RepeatN
  44. *****************************************************************************}
  45. procedure second_while_repeatn(var p : ptree);
  46. var
  47. lcont,lbreak,lloop,
  48. oldclabel,oldblabel : pasmlabel;
  49. otlabel,oflabel : pasmlabel;
  50. begin
  51. getlabel(lloop);
  52. getlabel(lcont);
  53. getlabel(lbreak);
  54. { arrange continue and breaklabels: }
  55. oldclabel:=aktcontinuelabel;
  56. oldblabel:=aktbreaklabel;
  57. { handling code at the end as it is much more efficient, and makes
  58. while equal to repeat loop, only the end true/false is swapped (PFV) }
  59. if p^.treetype=whilen then
  60. emitjmp(C_None,lcont);
  61. emitlab(lloop);
  62. aktcontinuelabel:=lcont;
  63. aktbreaklabel:=lbreak;
  64. cleartempgen;
  65. if assigned(p^.right) then
  66. secondpass(p^.right);
  67. emitlab(lcont);
  68. otlabel:=truelabel;
  69. oflabel:=falselabel;
  70. if p^.treetype=whilen then
  71. begin
  72. truelabel:=lloop;
  73. falselabel:=lbreak;
  74. end
  75. { repeatn }
  76. else
  77. begin
  78. truelabel:=lbreak;
  79. falselabel:=lloop;
  80. end;
  81. cleartempgen;
  82. secondpass(p^.left);
  83. maketojumpbool(p^.left);
  84. emitlab(lbreak);
  85. freelabel(lloop);
  86. freelabel(lcont);
  87. freelabel(lbreak);
  88. truelabel:=otlabel;
  89. falselabel:=oflabel;
  90. aktcontinuelabel:=oldclabel;
  91. aktbreaklabel:=oldblabel;
  92. end;
  93. {*****************************************************************************
  94. SecondIfN
  95. *****************************************************************************}
  96. procedure secondifn(var p : ptree);
  97. var
  98. hl,otlabel,oflabel : pasmlabel;
  99. begin
  100. otlabel:=truelabel;
  101. oflabel:=falselabel;
  102. getlabel(truelabel);
  103. getlabel(falselabel);
  104. cleartempgen;
  105. secondpass(p^.left);
  106. maketojumpbool(p^.left);
  107. if assigned(p^.right) then
  108. begin
  109. emitlab(truelabel);
  110. cleartempgen;
  111. secondpass(p^.right);
  112. end;
  113. if assigned(p^.t1) then
  114. begin
  115. if assigned(p^.right) then
  116. begin
  117. getlabel(hl);
  118. { do go back to if line !! }
  119. aktfilepos:=exprasmlist^.getlasttaifilepos^;
  120. emitjmp(C_None,hl);
  121. end;
  122. emitlab(falselabel);
  123. cleartempgen;
  124. secondpass(p^.t1);
  125. if assigned(p^.right) then
  126. emitlab(hl);
  127. end
  128. else
  129. begin
  130. emitlab(falselabel);
  131. end;
  132. if not(assigned(p^.right)) then
  133. begin
  134. emitlab(truelabel);
  135. end;
  136. freelabel(truelabel);
  137. freelabel(falselabel);
  138. truelabel:=otlabel;
  139. falselabel:=oflabel;
  140. end;
  141. {*****************************************************************************
  142. SecondFor
  143. *****************************************************************************}
  144. procedure secondfor(var p : ptree);
  145. var
  146. l3,oldclabel,oldblabel : pasmlabel;
  147. omitfirstcomp,temptovalue : boolean;
  148. hs : byte;
  149. temp1 : treference;
  150. hop : tasmop;
  151. hcond : tasmcond;
  152. cmpreg,cmp32 : tregister;
  153. opsize : topsize;
  154. count_var_is_signed : boolean;
  155. begin
  156. oldclabel:=aktcontinuelabel;
  157. oldblabel:=aktbreaklabel;
  158. getlabel(aktcontinuelabel);
  159. getlabel(aktbreaklabel);
  160. getlabel(l3);
  161. { could we spare the first comparison ? }
  162. omitfirstcomp:=false;
  163. if p^.right^.treetype=ordconstn then
  164. if p^.left^.right^.treetype=ordconstn then
  165. omitfirstcomp:=(p^.backward and (p^.left^.right^.value>=p^.right^.value))
  166. or (not(p^.backward) and (p^.left^.right^.value<=p^.right^.value));
  167. { only calculate reference }
  168. cleartempgen;
  169. secondpass(p^.t2);
  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. { first set the to value
  187. because the count var can be in the expression !! }
  188. cleartempgen;
  189. secondpass(p^.right);
  190. { calculate pointer value and check if changeable and if so }
  191. { load into temporary variable }
  192. if p^.right^.treetype<>ordconstn then
  193. begin
  194. temp1.symbol:=nil;
  195. gettempofsizereference(hs,temp1);
  196. temptovalue:=true;
  197. if (p^.right^.location.loc=LOC_REGISTER) or
  198. (p^.right^.location.loc=LOC_CREGISTER) then
  199. begin
  200. emit_reg_ref(A_MOV,opsize,p^.right^.location.register,
  201. newreference(temp1));
  202. end
  203. else
  204. concatcopy(p^.right^.location.reference,temp1,hs,false,false);
  205. end
  206. else
  207. temptovalue:=false;
  208. { produce start assignment }
  209. cleartempgen;
  210. secondpass(p^.left);
  211. count_var_is_signed:=is_signed(porddef(p^.t2^.resulttype));
  212. if temptovalue then
  213. begin
  214. if p^.t2^.location.loc=LOC_CREGISTER then
  215. begin
  216. emit_ref_reg(A_CMP,opsize,newreference(temp1),
  217. p^.t2^.location.register);
  218. end
  219. else
  220. begin
  221. emit_ref_reg(A_MOV,opsize,newreference(p^.t2^.location.reference),
  222. cmpreg);
  223. emit_ref_reg(A_CMP,opsize,newreference(temp1),
  224. cmpreg);
  225. end;
  226. end
  227. else
  228. begin
  229. if not(omitfirstcomp) then
  230. begin
  231. if p^.t2^.location.loc=LOC_CREGISTER then
  232. emit_const_reg(A_CMP,opsize,p^.right^.value,
  233. p^.t2^.location.register)
  234. else
  235. emit_const_ref(A_CMP,opsize,p^.right^.value,
  236. newreference(p^.t2^.location.reference));
  237. end;
  238. end;
  239. if p^.backward then
  240. if count_var_is_signed then
  241. hcond:=C_L
  242. else
  243. hcond:=C_B
  244. else
  245. if count_var_is_signed then
  246. hcond:=C_G
  247. else
  248. hcond:=C_A;
  249. if not(omitfirstcomp) or temptovalue then
  250. emitjmp(hcond,aktbreaklabel);
  251. { align loop target }
  252. if not(cs_littlesize in aktglobalswitches) then
  253. exprasmlist^.concat(new(pai_align,init_op(4,$90)));
  254. emitlab(l3);
  255. { help register must not be in instruction block }
  256. cleartempgen;
  257. if assigned(p^.t1) then
  258. secondpass(p^.t1);
  259. emitlab(aktcontinuelabel);
  260. { makes no problems there }
  261. cleartempgen;
  262. { demand help register again }
  263. cmp32:=getregister32;
  264. case hs of
  265. 1 : begin
  266. opsize:=S_B;
  267. cmpreg:=reg32toreg8(cmp32);
  268. end;
  269. 2 : begin
  270. opsize:=S_W;
  271. cmpreg:=reg32toreg16(cmp32);
  272. end;
  273. 4 : opsize:=S_L;
  274. end;
  275. { produce comparison and the corresponding }
  276. { jump }
  277. if temptovalue then
  278. begin
  279. if p^.t2^.location.loc=LOC_CREGISTER then
  280. begin
  281. emit_ref_reg(A_CMP,opsize,newreference(temp1),
  282. p^.t2^.location.register);
  283. end
  284. else
  285. begin
  286. emit_ref_reg(A_MOV,opsize,newreference(p^.t2^.location.reference),
  287. cmpreg);
  288. emit_ref_reg(A_CMP,opsize,newreference(temp1),
  289. cmpreg);
  290. end;
  291. end
  292. else
  293. begin
  294. if p^.t2^.location.loc=LOC_CREGISTER then
  295. emit_const_reg(A_CMP,opsize,p^.right^.value,
  296. p^.t2^.location.register)
  297. else
  298. emit_const_ref(A_CMP,opsize,p^.right^.value,
  299. newreference(p^.t2^.location.reference));
  300. end;
  301. if p^.backward then
  302. if count_var_is_signed then
  303. hcond:=C_LE
  304. else
  305. hcond:=C_BE
  306. else
  307. if count_var_is_signed then
  308. hcond:=C_GE
  309. else
  310. hcond:=C_AE;
  311. emitjmp(hcond,aktbreaklabel);
  312. { according to count direction DEC or INC... }
  313. { must be after the test because of 0to 255 for bytes !! }
  314. if p^.backward then
  315. hop:=A_DEC
  316. else
  317. hop:=A_INC;
  318. if p^.t2^.location.loc=LOC_CREGISTER then
  319. emit_reg(hop,opsize,p^.t2^.location.register)
  320. else
  321. emit_ref(hop,opsize,newreference(p^.t2^.location.reference));
  322. emitjmp(C_None,l3);
  323. { this is the break label: }
  324. emitlab(aktbreaklabel);
  325. ungetregister32(cmp32);
  326. if temptovalue then
  327. ungetiftemp(temp1);
  328. freelabel(aktcontinuelabel);
  329. freelabel(aktbreaklabel);
  330. freelabel(l3);
  331. aktcontinuelabel:=oldclabel;
  332. aktbreaklabel:=oldblabel;
  333. end;
  334. {*****************************************************************************
  335. SecondExitN
  336. *****************************************************************************}
  337. procedure secondexitn(var p : ptree);
  338. var
  339. is_mem : boolean;
  340. {op : tasmop;
  341. s : topsize;}
  342. otlabel,oflabel : pasmlabel;
  343. label
  344. do_jmp;
  345. begin
  346. if assigned(p^.left) then
  347. if p^.left^.treetype=assignn then
  348. begin
  349. { just do a normal assignment followed by exit }
  350. secondpass(p^.left);
  351. emitjmp(C_None,aktexitlabel);
  352. end
  353. else
  354. begin
  355. otlabel:=truelabel;
  356. oflabel:=falselabel;
  357. getlabel(truelabel);
  358. getlabel(falselabel);
  359. secondpass(p^.left);
  360. case p^.left^.location.loc of
  361. LOC_FPU : goto do_jmp;
  362. LOC_MEM,
  363. LOC_REFERENCE : is_mem:=true;
  364. LOC_CREGISTER,
  365. LOC_REGISTER : is_mem:=false;
  366. LOC_FLAGS : begin
  367. emit_flag2reg(p^.left^.location.resflags,R_AL);
  368. goto do_jmp;
  369. end;
  370. LOC_JUMP : begin
  371. emitlab(truelabel);
  372. emit_const_reg(A_MOV,S_B,1,R_AL);
  373. emitjmp(C_None,aktexit2label);
  374. emitlab(falselabel);
  375. emit_reg_reg(A_XOR,S_B,R_AL,R_AL);
  376. goto do_jmp;
  377. end;
  378. else
  379. internalerror(2001);
  380. end;
  381. case procinfo^.retdef^.deftype of
  382. orddef,
  383. enumdef : begin
  384. case procinfo^.retdef^.size of
  385. 4 : if is_mem then
  386. emit_ref_reg(A_MOV,S_L,
  387. newreference(p^.left^.location.reference),R_EAX)
  388. else
  389. emit_reg_reg(A_MOV,S_L,p^.left^.location.register,R_EAX);
  390. 2 : if is_mem then
  391. emit_ref_reg(A_MOV,S_W,
  392. newreference(p^.left^.location.reference),R_AX)
  393. else
  394. emit_reg_reg(A_MOV,S_W,makereg16(p^.left^.location.register),R_AX);
  395. 1 : if is_mem then
  396. emit_ref_reg(A_MOV,S_B,
  397. newreference(p^.left^.location.reference),R_AL)
  398. else
  399. emit_reg_reg(A_MOV,S_B,makereg8(p^.left^.location.register),R_AL);
  400. end;
  401. end;
  402. pointerdef,
  403. procvardef : begin
  404. if is_mem then
  405. emit_ref_reg(A_MOV,S_L,
  406. newreference(p^.left^.location.reference),R_EAX)
  407. else
  408. emit_reg_reg(A_MOV,S_L,
  409. p^.left^.location.register,R_EAX);
  410. end;
  411. floatdef : begin
  412. if pfloatdef(procinfo^.retdef)^.typ=f32bit then
  413. begin
  414. if is_mem then
  415. emit_ref_reg(A_MOV,S_L,
  416. newreference(p^.left^.location.reference),R_EAX)
  417. else
  418. emit_reg_reg(A_MOV,S_L,p^.left^.location.register,R_EAX);
  419. end
  420. else
  421. if is_mem then
  422. floatload(pfloatdef(procinfo^.retdef)^.typ,p^.left^.location.reference);
  423. end;
  424. end;
  425. do_jmp:
  426. freelabel(truelabel);
  427. freelabel(falselabel);
  428. truelabel:=otlabel;
  429. falselabel:=oflabel;
  430. emitjmp(C_None,aktexit2label);
  431. end
  432. else
  433. begin
  434. emitjmp(C_None,aktexitlabel);
  435. end;
  436. end;
  437. {*****************************************************************************
  438. SecondBreakN
  439. *****************************************************************************}
  440. procedure secondbreakn(var p : ptree);
  441. begin
  442. if aktbreaklabel<>nil then
  443. emitjmp(C_None,aktbreaklabel)
  444. else
  445. CGMessage(cg_e_break_not_allowed);
  446. end;
  447. {*****************************************************************************
  448. SecondContinueN
  449. *****************************************************************************}
  450. procedure secondcontinuen(var p : ptree);
  451. begin
  452. if aktcontinuelabel<>nil then
  453. emitjmp(C_None,aktcontinuelabel)
  454. else
  455. CGMessage(cg_e_continue_not_allowed);
  456. end;
  457. {*****************************************************************************
  458. SecondGoto
  459. *****************************************************************************}
  460. procedure secondgoto(var p : ptree);
  461. begin
  462. emitjmp(C_None,p^.labelnr);
  463. end;
  464. {*****************************************************************************
  465. SecondLabel
  466. *****************************************************************************}
  467. procedure secondlabel(var p : ptree);
  468. begin
  469. emitlab(p^.labelnr);
  470. cleartempgen;
  471. secondpass(p^.left);
  472. end;
  473. {*****************************************************************************
  474. SecondRaise
  475. *****************************************************************************}
  476. procedure secondraise(var p : ptree);
  477. var
  478. a : pasmlabel;
  479. begin
  480. if assigned(p^.left) then
  481. begin
  482. { generate the address }
  483. if assigned(p^.right) then
  484. begin
  485. secondpass(p^.right);
  486. if codegenerror then
  487. exit;
  488. end
  489. else
  490. begin
  491. getlabel(a);
  492. emitlab(a);
  493. emit_sym(A_PUSH,S_L,a);
  494. end;
  495. secondpass(p^.left);
  496. if codegenerror then
  497. exit;
  498. case p^.left^.location.loc of
  499. LOC_MEM,LOC_REFERENCE:
  500. emit_ref(A_PUSH,S_L,
  501. newreference(p^.left^.location.reference));
  502. LOC_CREGISTER,LOC_REGISTER : emit_reg(A_PUSH,S_L,
  503. p^.left^.location.register);
  504. else CGMessage(type_e_mismatch);
  505. end;
  506. emitcall('FPC_RAISEEXCEPTION');
  507. end
  508. else
  509. begin
  510. emitcall('FPC_POPADDRSTACK');
  511. emitcall('FPC_RERAISE');
  512. end;
  513. end;
  514. {*****************************************************************************
  515. SecondTryExcept
  516. *****************************************************************************}
  517. var
  518. endexceptlabel : pasmlabel;
  519. procedure secondtryexcept(var p : ptree);
  520. var
  521. exceptlabel,doexceptlabel,oldendexceptlabel,
  522. lastonlabel : pasmlabel;
  523. begin
  524. { this can be called recursivly }
  525. oldendexceptlabel:=endexceptlabel;
  526. { we modify EAX }
  527. usedinproc:=usedinproc or ($80 shr byte(R_EAX));
  528. getlabel(exceptlabel);
  529. getlabel(doexceptlabel);
  530. getlabel(endexceptlabel);
  531. getlabel(lastonlabel);
  532. push_int (1); { push type of exceptionframe }
  533. emitcall('FPC_PUSHEXCEPTADDR');
  534. emit_reg(A_PUSH,S_L,R_EAX);
  535. emitcall('FPC_SETJMP');
  536. emit_reg(A_PUSH,S_L,R_EAX);
  537. emit_reg_reg(A_TEST,S_L,R_EAX,R_EAX);
  538. emitjmp(C_NE,exceptlabel);
  539. { try code }
  540. secondpass(p^.left);
  541. if codegenerror then
  542. exit;
  543. emitlab(exceptlabel);
  544. emitcall('FPC_POPADDRSTACK');
  545. emit_reg(A_POP,S_L,R_EAX);
  546. emit_reg_reg(A_TEST,S_L,R_EAX,R_EAX);
  547. emitjmp(C_E,endexceptlabel);
  548. emitlab(doexceptlabel);
  549. if assigned(p^.right) then
  550. secondpass(p^.right);
  551. emitlab(lastonlabel);
  552. { default handling }
  553. if assigned(p^.t1) then
  554. begin
  555. { FPC_CATCHES must be called with
  556. 'default handler' flag (=-1)
  557. }
  558. push_int (-1);
  559. emitcall('FPC_CATCHES');
  560. maybe_loadesi;
  561. secondpass(p^.t1);
  562. emitcall('FPC_POPOBJECTSTACK');
  563. maybe_loadesi;
  564. end
  565. else
  566. emitcall('FPC_RERAISE');
  567. { reraise doesn't need a maybe_loadesi because it never }
  568. { returns (FK) }
  569. emitlab(endexceptlabel);
  570. freelabel(exceptlabel);
  571. freelabel(doexceptlabel);
  572. freelabel(endexceptlabel);
  573. freelabel(lastonlabel);
  574. endexceptlabel:=oldendexceptlabel;
  575. end;
  576. procedure secondon(var p : ptree);
  577. var
  578. nextonlabel : pasmlabel;
  579. ref : treference;
  580. begin
  581. getlabel(nextonlabel);
  582. { push the vmt }
  583. emit_sym(A_PUSH,S_L,
  584. newasmsymbol(p^.excepttype^.vmt_mangledname));
  585. emitcall('FPC_CATCHES');
  586. emit_reg_reg(A_TEST,S_L,R_EAX,R_EAX);
  587. emitjmp(C_E,nextonlabel);
  588. ref.symbol:=nil;
  589. gettempofsizereference(4,ref);
  590. { what a hack ! }
  591. if assigned(p^.exceptsymtable) then
  592. pvarsym(p^.exceptsymtable^.symindex^.first)^.address:=ref.offset;
  593. emit_reg_ref(A_MOV,S_L,
  594. R_EAX,newreference(ref));
  595. if assigned(p^.right) then
  596. begin
  597. { esi is destroyed by FPC_CATCHES }
  598. maybe_loadesi;
  599. secondpass(p^.right);
  600. end;
  601. emit_ref(A_PUSH,S_L,
  602. newreference(ref));
  603. emitcall('FPC_DESTROYEXCEPTION');
  604. emitcall('FPC_POPOBJECTSTACK');
  605. { clear some stuff }
  606. ungetiftemp(ref);
  607. emitjmp(C_None,endexceptlabel);
  608. emitlab(nextonlabel);
  609. { next on node }
  610. if assigned(p^.left) then
  611. secondpass(p^.left);
  612. end;
  613. {*****************************************************************************
  614. SecondTryFinally
  615. *****************************************************************************}
  616. procedure secondtryfinally(var p : ptree);
  617. var
  618. finallylabel,noreraiselabel : pasmlabel;
  619. oldaktexitlabel,exitfinallylabel : pasmlabel;
  620. oldaktexit2label : pasmlabel;
  621. begin
  622. { we modify EAX }
  623. usedinproc:=usedinproc or ($80 shr byte(R_EAX));
  624. getlabel(finallylabel);
  625. getlabel(noreraiselabel);
  626. oldaktexitlabel:=aktexitlabel;
  627. oldaktexit2label:=aktexit2label;
  628. getlabel(exitfinallylabel);
  629. aktexitlabel:=exitfinallylabel;
  630. aktexit2label:=exitfinallylabel;
  631. push_int(1); { Type of stack-frame must be pushed}
  632. emitcall('FPC_PUSHEXCEPTADDR');
  633. emit_reg(A_PUSH,S_L,R_EAX);
  634. emitcall('FPC_SETJMP');
  635. emit_reg(A_PUSH,S_L,R_EAX);
  636. emit_reg_reg(A_TEST,S_L,R_EAX,R_EAX);
  637. emitjmp(C_NE,finallylabel);
  638. { try code }
  639. secondpass(p^.left);
  640. if codegenerror then
  641. exit;
  642. emitlab(finallylabel);
  643. emitcall('FPC_POPADDRSTACK');
  644. { finally code }
  645. secondpass(p^.right);
  646. if codegenerror then
  647. exit;
  648. emit_reg(A_POP,S_L,R_EAX);
  649. emit_reg_reg(A_TEST,S_L,R_EAX,R_EAX);
  650. emitjmp(C_E,noreraiselabel);
  651. emit_reg(A_DEC,S_L,R_EAX);
  652. emitjmp(C_NE,oldaktexitlabel);
  653. emitcall('FPC_RERAISE');
  654. { reraise never returns ! }
  655. emitlab(exitfinallylabel);
  656. { do some magic for exit in the try block }
  657. emit_reg(A_POP,S_L,R_EAX);
  658. emit_const(A_PUSH,S_L,2);
  659. emitjmp(C_NONE,finallylabel);
  660. emitlab(noreraiselabel);
  661. aktexitlabel:=oldaktexitlabel;
  662. aktexit2label:=oldaktexit2label;
  663. end;
  664. {*****************************************************************************
  665. SecondFail
  666. *****************************************************************************}
  667. procedure secondfail(var p : ptree);
  668. begin
  669. emitjmp(C_None,faillabel);
  670. end;
  671. end.
  672. {
  673. $Log$
  674. Revision 1.56 1999-11-06 14:34:17 peter
  675. * truncated log to 20 revs
  676. Revision 1.55 1999/10/30 17:35:26 peter
  677. * fpc_freemem fpc_getmem new callings updated
  678. Revision 1.54 1999/10/21 16:41:37 florian
  679. * problems with readln fixed: esi wasn't restored correctly when
  680. reading ordinal fields of objects futher the register allocation
  681. didn't take care of the extra register when reading ordinal values
  682. * enumerations can now be used in constant indexes of properties
  683. Revision 1.53 1999/10/05 22:01:52 pierre
  684. * bug exit('test') + fail for classes
  685. Revision 1.52 1999/09/27 23:44:46 peter
  686. * procinfo is now a pointer
  687. * support for result setting in sub procedure
  688. Revision 1.51 1999/09/26 13:26:05 florian
  689. * exception patch of Romio nevertheless the excpetion handling
  690. needs some corections regarding register saving
  691. * gettempansistring is again a procedure
  692. Revision 1.50 1999/09/20 16:35:43 peter
  693. * restored old alignment, saves 40k on ppc386
  694. Revision 1.49 1999/09/15 20:35:37 florian
  695. * small fix to operator overloading when in MMX mode
  696. + the compiler uses now fldz and fld1 if possible
  697. + some fixes to floating point registers
  698. + some math. functions (arctan, ln, sin, cos, sqrt, sqr, pi) are now inlined
  699. * .... ???
  700. Revision 1.48 1999/09/07 07:56:37 peter
  701. * reload esi in except block to allow virtual methods
  702. Revision 1.47 1999/08/25 11:59:42 jonas
  703. * changed pai386, paippc and paiapha (same for tai*) to paicpu (taicpu)
  704. Revision 1.46 1999/08/19 13:06:47 pierre
  705. * _FAIL will now free memory correctly
  706. and reset VMT field on static instances
  707. (not yet tested for classes, is it allowed ?)
  708. + emit_.... all variant defined here to avoid tons of
  709. exprasmlist^.concat(new(paicpu,...) in cg386***
  710. Revision 1.45 1999/08/04 00:22:46 florian
  711. * renamed i386asm and i386base to cpuasm and cpubase
  712. Revision 1.44 1999/08/03 22:02:39 peter
  713. * moved bitmask constants to sets
  714. * some other type/const renamings
  715. Revision 1.43 1999/07/26 12:13:45 florian
  716. * exit in try..finally blocks needed a second fix
  717. * a raise in a try..finally lead into a endless loop, fixed
  718. Revision 1.42 1999/07/26 09:41:59 florian
  719. * bugs 494-496 fixed
  720. Revision 1.41 1999/07/05 20:13:09 peter
  721. * removed temp defines
  722. Revision 1.40 1999/06/14 00:43:35 peter
  723. * merged
  724. Revision 1.39.2.1 1999/06/14 00:39:29 peter
  725. * don't pop object stack in catches, because it's needed for reraise
  726. Revision 1.39 1999/05/27 19:44:12 peter
  727. * removed oldasm
  728. * plabel -> pasmlabel
  729. * -a switches to source writing automaticly
  730. * assembler readers OOPed
  731. * asmsymbol automaticly external
  732. * jumptables and other label fixes for asm readers
  733. Revision 1.38 1999/05/21 13:54:48 peter
  734. * NEWLAB for label as symbol
  735. Revision 1.37 1999/05/17 21:57:01 florian
  736. * new temporary ansistring handling
  737. }