cg386flw.pas 29 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908
  1. {
  2. $Id$
  3. Copyright (c) 1993-99 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,tcflw;
  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^.returntype.def^.deftype of
  382. pointerdef,
  383. procvardef : begin
  384. if is_mem then
  385. emit_ref_reg(A_MOV,S_L,
  386. newreference(p^.left^.location.reference),R_EAX)
  387. else
  388. emit_reg_reg(A_MOV,S_L,
  389. p^.left^.location.register,R_EAX);
  390. end;
  391. floatdef : begin
  392. if pfloatdef(procinfo^.returntype.def)^.typ=f32bit then
  393. begin
  394. if is_mem then
  395. emit_ref_reg(A_MOV,S_L,
  396. newreference(p^.left^.location.reference),R_EAX)
  397. else
  398. emit_reg_reg(A_MOV,S_L,p^.left^.location.register,R_EAX);
  399. end
  400. else
  401. if is_mem then
  402. floatload(pfloatdef(procinfo^.returntype.def)^.typ,p^.left^.location.reference);
  403. end;
  404. { orddef,
  405. enumdef : }
  406. else
  407. { it can be anything shorter than 4 bytes PM
  408. this caused form bug 711 }
  409. begin
  410. case procinfo^.returntype.def^.size of
  411. { if its 3 bytes only we can still
  412. copy one of garbage ! PM }
  413. 4,3 : if is_mem then
  414. emit_ref_reg(A_MOV,S_L,
  415. newreference(p^.left^.location.reference),R_EAX)
  416. else
  417. emit_reg_reg(A_MOV,S_L,p^.left^.location.register,R_EAX);
  418. 2 : if is_mem then
  419. emit_ref_reg(A_MOV,S_W,
  420. newreference(p^.left^.location.reference),R_AX)
  421. else
  422. emit_reg_reg(A_MOV,S_W,makereg16(p^.left^.location.register),R_AX);
  423. 1 : if is_mem then
  424. emit_ref_reg(A_MOV,S_B,
  425. newreference(p^.left^.location.reference),R_AL)
  426. else
  427. emit_reg_reg(A_MOV,S_B,makereg8(p^.left^.location.register),R_AL);
  428. end;
  429. end;
  430. end;
  431. do_jmp:
  432. freelabel(truelabel);
  433. freelabel(falselabel);
  434. truelabel:=otlabel;
  435. falselabel:=oflabel;
  436. emitjmp(C_None,aktexit2label);
  437. end
  438. else
  439. begin
  440. emitjmp(C_None,aktexitlabel);
  441. end;
  442. end;
  443. {*****************************************************************************
  444. SecondBreakN
  445. *****************************************************************************}
  446. procedure secondbreakn(var p : ptree);
  447. begin
  448. if aktbreaklabel<>nil then
  449. emitjmp(C_None,aktbreaklabel)
  450. else
  451. CGMessage(cg_e_break_not_allowed);
  452. end;
  453. {*****************************************************************************
  454. SecondContinueN
  455. *****************************************************************************}
  456. procedure secondcontinuen(var p : ptree);
  457. begin
  458. if aktcontinuelabel<>nil then
  459. emitjmp(C_None,aktcontinuelabel)
  460. else
  461. CGMessage(cg_e_continue_not_allowed);
  462. end;
  463. {*****************************************************************************
  464. SecondGoto
  465. *****************************************************************************}
  466. procedure secondgoto(var p : ptree);
  467. begin
  468. emitjmp(C_None,p^.labelnr);
  469. if aktexceptblock<>ptree(p^.labsym^.code)^.exceptionblock then
  470. CGMessage(cg_e_goto_inout_of_exception_block);
  471. end;
  472. {*****************************************************************************
  473. SecondLabel
  474. *****************************************************************************}
  475. procedure secondlabel(var p : ptree);
  476. begin
  477. emitlab(p^.labelnr);
  478. cleartempgen;
  479. secondpass(p^.left);
  480. end;
  481. {*****************************************************************************
  482. SecondRaise
  483. *****************************************************************************}
  484. procedure secondraise(var p : ptree);
  485. var
  486. a : pasmlabel;
  487. begin
  488. if assigned(p^.left) then
  489. begin
  490. { generate the address }
  491. if assigned(p^.right) then
  492. begin
  493. secondpass(p^.right);
  494. if codegenerror then
  495. exit;
  496. emit_push_loc(p^.right^.location);
  497. end
  498. else
  499. begin
  500. getlabel(a);
  501. emitlab(a);
  502. emit_sym(A_PUSH,S_L,a);
  503. end;
  504. secondpass(p^.left);
  505. if codegenerror then
  506. exit;
  507. case p^.left^.location.loc of
  508. LOC_MEM,LOC_REFERENCE:
  509. emit_ref(A_PUSH,S_L,
  510. newreference(p^.left^.location.reference));
  511. LOC_CREGISTER,LOC_REGISTER : emit_reg(A_PUSH,S_L,
  512. p^.left^.location.register);
  513. else CGMessage(type_e_mismatch);
  514. end;
  515. emitcall('FPC_RAISEEXCEPTION');
  516. end
  517. else
  518. begin
  519. emitcall('FPC_POPADDRSTACK');
  520. emitcall('FPC_RERAISE');
  521. end;
  522. end;
  523. {*****************************************************************************
  524. SecondTryExcept
  525. *****************************************************************************}
  526. var
  527. endexceptlabel : pasmlabel;
  528. procedure secondtryexcept(var p : ptree);
  529. var
  530. exceptlabel,doexceptlabel,oldendexceptlabel,
  531. lastonlabel : pasmlabel;
  532. oldexceptblock : ptree;
  533. begin
  534. { this can be called recursivly }
  535. oldendexceptlabel:=endexceptlabel;
  536. { we modify EAX }
  537. usedinproc:=usedinproc or ($80 shr byte(R_EAX));
  538. getlabel(exceptlabel);
  539. getlabel(doexceptlabel);
  540. getlabel(endexceptlabel);
  541. getlabel(lastonlabel);
  542. push_int (1); { push type of exceptionframe }
  543. emitcall('FPC_PUSHEXCEPTADDR');
  544. emit_reg(A_PUSH,S_L,R_EAX);
  545. emitcall('FPC_SETJMP');
  546. emit_reg(A_PUSH,S_L,R_EAX);
  547. emit_reg_reg(A_TEST,S_L,R_EAX,R_EAX);
  548. emitjmp(C_NE,exceptlabel);
  549. { try code }
  550. oldexceptblock:=aktexceptblock;
  551. aktexceptblock:=p^.left;
  552. secondpass(p^.left);
  553. aktexceptblock:=oldexceptblock;
  554. if codegenerror then
  555. exit;
  556. emitlab(exceptlabel);
  557. emitcall('FPC_POPADDRSTACK');
  558. emit_reg(A_POP,S_L,R_EAX);
  559. emit_reg_reg(A_TEST,S_L,R_EAX,R_EAX);
  560. emitjmp(C_E,endexceptlabel);
  561. emitlab(doexceptlabel);
  562. if assigned(p^.right) then
  563. begin
  564. oldexceptblock:=aktexceptblock;
  565. aktexceptblock:=p^.right;
  566. secondpass(p^.right);
  567. aktexceptblock:=oldexceptblock;
  568. end;
  569. emitlab(lastonlabel);
  570. { default handling }
  571. if assigned(p^.t1) then
  572. begin
  573. { FPC_CATCHES must be called with
  574. 'default handler' flag (=-1)
  575. }
  576. push_int (-1);
  577. emitcall('FPC_CATCHES');
  578. if assigned(p^.t1) then
  579. begin
  580. maybe_loadesi;
  581. oldexceptblock:=aktexceptblock;
  582. aktexceptblock:=p^.t1;
  583. secondpass(p^.t1);
  584. aktexceptblock:=oldexceptblock;
  585. end;
  586. emitcall('FPC_POPOBJECTSTACK');
  587. maybe_loadesi;
  588. end
  589. else
  590. emitcall('FPC_RERAISE');
  591. { reraise doesn't need a maybe_loadesi because it never }
  592. { returns (FK) }
  593. emitlab(endexceptlabel);
  594. freelabel(exceptlabel);
  595. freelabel(doexceptlabel);
  596. freelabel(endexceptlabel);
  597. freelabel(lastonlabel);
  598. endexceptlabel:=oldendexceptlabel;
  599. end;
  600. procedure secondon(var p : ptree);
  601. var
  602. nextonlabel : pasmlabel;
  603. ref : treference;
  604. oldexceptblock : ptree;
  605. begin
  606. getlabel(nextonlabel);
  607. { push the vmt }
  608. emit_sym(A_PUSH,S_L,
  609. newasmsymbol(p^.excepttype^.vmt_mangledname));
  610. emitcall('FPC_CATCHES');
  611. emit_reg_reg(A_TEST,S_L,R_EAX,R_EAX);
  612. emitjmp(C_E,nextonlabel);
  613. ref.symbol:=nil;
  614. gettempofsizereference(4,ref);
  615. { what a hack ! }
  616. if assigned(p^.exceptsymtable) then
  617. pvarsym(p^.exceptsymtable^.symindex^.first)^.address:=ref.offset;
  618. emit_reg_ref(A_MOV,S_L,
  619. R_EAX,newreference(ref));
  620. if assigned(p^.right) then
  621. begin
  622. { esi is destroyed by FPC_CATCHES }
  623. maybe_loadesi;
  624. oldexceptblock:=aktexceptblock;
  625. aktexceptblock:=p^.right;
  626. secondpass(p^.right);
  627. aktexceptblock:=oldexceptblock;
  628. end;
  629. emit_ref(A_PUSH,S_L,newreference(ref));
  630. emitcall('FPC_DESTROYEXCEPTION');
  631. emitcall('FPC_POPOBJECTSTACK');
  632. maybe_loadesi;
  633. { clear some stuff }
  634. ungetiftemp(ref);
  635. emitjmp(C_None,endexceptlabel);
  636. emitlab(nextonlabel);
  637. { next on node }
  638. if assigned(p^.left) then
  639. secondpass(p^.left);
  640. end;
  641. {*****************************************************************************
  642. SecondTryFinally
  643. *****************************************************************************}
  644. procedure secondtryfinally(var p : ptree);
  645. var
  646. finallylabel,noreraiselabel : pasmlabel;
  647. oldaktexitlabel,exitfinallylabel : pasmlabel;
  648. oldaktexit2label : pasmlabel;
  649. oldexceptblock : ptree;
  650. begin
  651. { we modify EAX }
  652. usedinproc:=usedinproc or ($80 shr byte(R_EAX));
  653. getlabel(finallylabel);
  654. getlabel(noreraiselabel);
  655. oldaktexitlabel:=aktexitlabel;
  656. oldaktexit2label:=aktexit2label;
  657. getlabel(exitfinallylabel);
  658. aktexitlabel:=exitfinallylabel;
  659. aktexit2label:=exitfinallylabel;
  660. push_int(1); { Type of stack-frame must be pushed}
  661. emitcall('FPC_PUSHEXCEPTADDR');
  662. emit_reg(A_PUSH,S_L,R_EAX);
  663. emitcall('FPC_SETJMP');
  664. emit_reg(A_PUSH,S_L,R_EAX);
  665. emit_reg_reg(A_TEST,S_L,R_EAX,R_EAX);
  666. emitjmp(C_NE,finallylabel);
  667. { try code }
  668. if assigned(p^.left) then
  669. begin
  670. oldexceptblock:=aktexceptblock;
  671. aktexceptblock:=p^.left;
  672. secondpass(p^.left);
  673. if codegenerror then
  674. exit;
  675. aktexceptblock:=oldexceptblock;
  676. end;
  677. emitlab(finallylabel);
  678. emitcall('FPC_POPADDRSTACK');
  679. { finally code }
  680. oldexceptblock:=aktexceptblock;
  681. aktexceptblock:=p^.right;
  682. secondpass(p^.right);
  683. aktexceptblock:=oldexceptblock;
  684. if codegenerror then
  685. exit;
  686. emit_reg(A_POP,S_L,R_EAX);
  687. emit_reg_reg(A_TEST,S_L,R_EAX,R_EAX);
  688. emitjmp(C_E,noreraiselabel);
  689. emit_reg(A_DEC,S_L,R_EAX);
  690. emitjmp(C_NE,oldaktexitlabel);
  691. emitcall('FPC_RERAISE');
  692. { reraise never returns ! }
  693. emitlab(exitfinallylabel);
  694. { do some magic for exit in the try block }
  695. emit_reg(A_POP,S_L,R_EAX);
  696. emit_const(A_PUSH,S_L,2);
  697. emitjmp(C_NONE,finallylabel);
  698. emitlab(noreraiselabel);
  699. aktexitlabel:=oldaktexitlabel;
  700. aktexit2label:=oldaktexit2label;
  701. end;
  702. {*****************************************************************************
  703. SecondFail
  704. *****************************************************************************}
  705. procedure secondfail(var p : ptree);
  706. begin
  707. emitjmp(C_None,faillabel);
  708. end;
  709. end.
  710. {
  711. $Log$
  712. Revision 1.61 1999-12-14 09:58:41 florian
  713. + compiler checks now if a goto leaves an exception block
  714. Revision 1.60 1999/12/01 12:36:23 peter
  715. * fixed selfpointer after destroyexception
  716. Revision 1.59 1999/11/30 10:40:42 peter
  717. + ttype, tsymlist
  718. Revision 1.58 1999/11/28 23:15:23 pierre
  719. * fix for form bug 721
  720. Revision 1.57 1999/11/15 21:49:09 peter
  721. * push address also for raise at
  722. Revision 1.56 1999/11/06 14:34:17 peter
  723. * truncated log to 20 revs
  724. Revision 1.55 1999/10/30 17:35:26 peter
  725. * fpc_freemem fpc_getmem new callings updated
  726. Revision 1.54 1999/10/21 16:41:37 florian
  727. * problems with readln fixed: esi wasn't restored correctly when
  728. reading ordinal fields of objects futher the register allocation
  729. didn't take care of the extra register when reading ordinal values
  730. * enumerations can now be used in constant indexes of properties
  731. Revision 1.53 1999/10/05 22:01:52 pierre
  732. * bug exit('test') + fail for classes
  733. Revision 1.52 1999/09/27 23:44:46 peter
  734. * procinfo is now a pointer
  735. * support for result setting in sub procedure
  736. Revision 1.51 1999/09/26 13:26:05 florian
  737. * exception patch of Romio nevertheless the excpetion handling
  738. needs some corections regarding register saving
  739. * gettempansistring is again a procedure
  740. Revision 1.50 1999/09/20 16:35:43 peter
  741. * restored old alignment, saves 40k on ppc386
  742. Revision 1.49 1999/09/15 20:35:37 florian
  743. * small fix to operator overloading when in MMX mode
  744. + the compiler uses now fldz and fld1 if possible
  745. + some fixes to floating point registers
  746. + some math. functions (arctan, ln, sin, cos, sqrt, sqr, pi) are now inlined
  747. * .... ???
  748. Revision 1.48 1999/09/07 07:56:37 peter
  749. * reload esi in except block to allow virtual methods
  750. Revision 1.47 1999/08/25 11:59:42 jonas
  751. * changed pai386, paippc and paiapha (same for tai*) to paicpu (taicpu)
  752. Revision 1.46 1999/08/19 13:06:47 pierre
  753. * _FAIL will now free memory correctly
  754. and reset VMT field on static instances
  755. (not yet tested for classes, is it allowed ?)
  756. + emit_.... all variant defined here to avoid tons of
  757. exprasmlist^.concat(new(paicpu,...) in cg386***
  758. Revision 1.45 1999/08/04 00:22:46 florian
  759. * renamed i386asm and i386base to cpuasm and cpubase
  760. Revision 1.44 1999/08/03 22:02:39 peter
  761. * moved bitmask constants to sets
  762. * some other type/const renamings
  763. Revision 1.43 1999/07/26 12:13:45 florian
  764. * exit in try..finally blocks needed a second fix
  765. * a raise in a try..finally lead into a endless loop, fixed
  766. Revision 1.42 1999/07/26 09:41:59 florian
  767. * bugs 494-496 fixed
  768. Revision 1.41 1999/07/05 20:13:09 peter
  769. * removed temp defines
  770. Revision 1.40 1999/06/14 00:43:35 peter
  771. * merged
  772. Revision 1.39.2.1 1999/06/14 00:39:29 peter
  773. * don't pop object stack in catches, because it's needed for reraise
  774. Revision 1.39 1999/05/27 19:44:12 peter
  775. * removed oldasm
  776. * plabel -> pasmlabel
  777. * -a switches to source writing automaticly
  778. * assembler readers OOPed
  779. * asmsymbol automaticly external
  780. * jumptables and other label fixes for asm readers
  781. Revision 1.38 1999/05/21 13:54:48 peter
  782. * NEWLAB for label as symbol
  783. Revision 1.37 1999/05/17 21:57:01 florian
  784. * new temporary ansistring handling
  785. }