cg386flw.pas 27 KB

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