cg386flw.pas 28 KB

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