cg386flw.pas 31 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974
  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. 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. emitlab(l3);
  252. { help register must not be in instruction block }
  253. cleartempgen;
  254. if assigned(p^.t1) then
  255. secondpass(p^.t1);
  256. emitlab(aktcontinuelabel);
  257. { makes no problems there }
  258. cleartempgen;
  259. { demand help register again }
  260. cmp32:=getregister32;
  261. case hs of
  262. 1 : begin
  263. opsize:=S_B;
  264. cmpreg:=reg32toreg8(cmp32);
  265. end;
  266. 2 : begin
  267. opsize:=S_W;
  268. cmpreg:=reg32toreg16(cmp32);
  269. end;
  270. 4 : opsize:=S_L;
  271. end;
  272. { produce comparison and the corresponding }
  273. { jump }
  274. if temptovalue then
  275. begin
  276. if p^.t2^.location.loc=LOC_CREGISTER then
  277. begin
  278. emit_ref_reg(A_CMP,opsize,newreference(temp1),
  279. p^.t2^.location.register);
  280. end
  281. else
  282. begin
  283. emit_ref_reg(A_MOV,opsize,newreference(p^.t2^.location.reference),
  284. cmpreg);
  285. emit_ref_reg(A_CMP,opsize,newreference(temp1),
  286. cmpreg);
  287. end;
  288. end
  289. else
  290. begin
  291. if p^.t2^.location.loc=LOC_CREGISTER then
  292. emit_const_reg(A_CMP,opsize,p^.right^.value,
  293. p^.t2^.location.register)
  294. else
  295. emit_const_ref(A_CMP,opsize,p^.right^.value,
  296. newreference(p^.t2^.location.reference));
  297. end;
  298. if p^.backward then
  299. if count_var_is_signed then
  300. hcond:=C_LE
  301. else
  302. hcond:=C_BE
  303. else
  304. if count_var_is_signed then
  305. hcond:=C_GE
  306. else
  307. hcond:=C_AE;
  308. emitjmp(hcond,aktbreaklabel);
  309. { according to count direction DEC or INC... }
  310. { must be after the test because of 0to 255 for bytes !! }
  311. if p^.backward then
  312. hop:=A_DEC
  313. else
  314. hop:=A_INC;
  315. if p^.t2^.location.loc=LOC_CREGISTER then
  316. emit_reg(hop,opsize,p^.t2^.location.register)
  317. else
  318. emit_ref(hop,opsize,newreference(p^.t2^.location.reference));
  319. emitjmp(C_None,l3);
  320. { this is the break label: }
  321. emitlab(aktbreaklabel);
  322. ungetregister32(cmp32);
  323. if temptovalue then
  324. ungetiftemp(temp1);
  325. freelabel(aktcontinuelabel);
  326. freelabel(aktbreaklabel);
  327. freelabel(l3);
  328. aktcontinuelabel:=oldclabel;
  329. aktbreaklabel:=oldblabel;
  330. end;
  331. {*****************************************************************************
  332. SecondExitN
  333. *****************************************************************************}
  334. procedure secondexitn(var p : ptree);
  335. var
  336. is_mem : boolean;
  337. {op : tasmop;
  338. s : topsize;}
  339. otlabel,oflabel : pasmlabel;
  340. label
  341. do_jmp;
  342. begin
  343. if assigned(p^.left) then
  344. begin
  345. otlabel:=truelabel;
  346. oflabel:=falselabel;
  347. getlabel(truelabel);
  348. getlabel(falselabel);
  349. secondpass(p^.left);
  350. case p^.left^.location.loc of
  351. LOC_FPU : goto do_jmp;
  352. LOC_MEM,
  353. LOC_REFERENCE : is_mem:=true;
  354. LOC_CREGISTER,
  355. LOC_REGISTER : is_mem:=false;
  356. LOC_FLAGS : begin
  357. emit_flag2reg(p^.left^.location.resflags,R_AL);
  358. goto do_jmp;
  359. end;
  360. LOC_JUMP : begin
  361. emitlab(truelabel);
  362. emit_const_reg(A_MOV,S_B,1,R_AL);
  363. emitjmp(C_None,aktexit2label);
  364. emitlab(falselabel);
  365. emit_reg_reg(A_XOR,S_B,R_AL,R_AL);
  366. goto do_jmp;
  367. end;
  368. else
  369. internalerror(2001);
  370. end;
  371. case procinfo.retdef^.deftype of
  372. orddef,
  373. enumdef : begin
  374. case procinfo.retdef^.size of
  375. 4 : if is_mem then
  376. emit_ref_reg(A_MOV,S_L,
  377. newreference(p^.left^.location.reference),R_EAX)
  378. else
  379. emit_reg_reg(A_MOV,S_L,p^.left^.location.register,R_EAX);
  380. 2 : if is_mem then
  381. emit_ref_reg(A_MOV,S_W,
  382. newreference(p^.left^.location.reference),R_AX)
  383. else
  384. emit_reg_reg(A_MOV,S_W,makereg16(p^.left^.location.register),R_AX);
  385. 1 : if is_mem then
  386. emit_ref_reg(A_MOV,S_B,
  387. newreference(p^.left^.location.reference),R_AL)
  388. else
  389. emit_reg_reg(A_MOV,S_B,makereg8(p^.left^.location.register),R_AL);
  390. end;
  391. end;
  392. pointerdef,
  393. procvardef : 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,
  399. p^.left^.location.register,R_EAX);
  400. end;
  401. floatdef : begin
  402. if pfloatdef(procinfo.retdef)^.typ=f32bit then
  403. 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,p^.left^.location.register,R_EAX);
  409. end
  410. else
  411. if is_mem then
  412. floatload(pfloatdef(procinfo.retdef)^.typ,p^.left^.location.reference);
  413. end;
  414. end;
  415. do_jmp:
  416. freelabel(truelabel);
  417. freelabel(falselabel);
  418. truelabel:=otlabel;
  419. falselabel:=oflabel;
  420. emitjmp(C_None,aktexit2label);
  421. end
  422. else
  423. begin
  424. emitjmp(C_None,aktexitlabel);
  425. end;
  426. end;
  427. {*****************************************************************************
  428. SecondBreakN
  429. *****************************************************************************}
  430. procedure secondbreakn(var p : ptree);
  431. begin
  432. if aktbreaklabel<>nil then
  433. emitjmp(C_None,aktbreaklabel)
  434. else
  435. CGMessage(cg_e_break_not_allowed);
  436. end;
  437. {*****************************************************************************
  438. SecondContinueN
  439. *****************************************************************************}
  440. procedure secondcontinuen(var p : ptree);
  441. begin
  442. if aktcontinuelabel<>nil then
  443. emitjmp(C_None,aktcontinuelabel)
  444. else
  445. CGMessage(cg_e_continue_not_allowed);
  446. end;
  447. {*****************************************************************************
  448. SecondGoto
  449. *****************************************************************************}
  450. procedure secondgoto(var p : ptree);
  451. begin
  452. emitjmp(C_None,p^.labelnr);
  453. end;
  454. {*****************************************************************************
  455. SecondLabel
  456. *****************************************************************************}
  457. procedure secondlabel(var p : ptree);
  458. begin
  459. emitlab(p^.labelnr);
  460. cleartempgen;
  461. secondpass(p^.left);
  462. end;
  463. {*****************************************************************************
  464. SecondRaise
  465. *****************************************************************************}
  466. procedure secondraise(var p : ptree);
  467. var
  468. a : pasmlabel;
  469. begin
  470. if assigned(p^.left) then
  471. begin
  472. { generate the address }
  473. if assigned(p^.right) then
  474. begin
  475. secondpass(p^.right);
  476. if codegenerror then
  477. exit;
  478. end
  479. else
  480. begin
  481. getlabel(a);
  482. emitlab(a);
  483. emit_sym(A_PUSH,S_L,a);
  484. end;
  485. secondpass(p^.left);
  486. if codegenerror then
  487. exit;
  488. case p^.left^.location.loc of
  489. LOC_MEM,LOC_REFERENCE:
  490. emit_ref(A_PUSH,S_L,
  491. newreference(p^.left^.location.reference));
  492. LOC_CREGISTER,LOC_REGISTER : emit_reg(A_PUSH,S_L,
  493. p^.left^.location.register);
  494. else CGMessage(type_e_mismatch);
  495. end;
  496. emitcall('FPC_RAISEEXCEPTION');
  497. end
  498. else
  499. begin
  500. emitcall('FPC_POPADDRSTACK');
  501. emitcall('FPC_RERAISE');
  502. end;
  503. end;
  504. {*****************************************************************************
  505. SecondTryExcept
  506. *****************************************************************************}
  507. var
  508. endexceptlabel : pasmlabel;
  509. procedure secondtryexcept(var p : ptree);
  510. var
  511. exceptlabel,doexceptlabel,oldendexceptlabel,
  512. lastonlabel : pasmlabel;
  513. begin
  514. { this can be called recursivly }
  515. oldendexceptlabel:=endexceptlabel;
  516. { we modify EAX }
  517. usedinproc:=usedinproc or ($80 shr byte(R_EAX));
  518. getlabel(exceptlabel);
  519. getlabel(doexceptlabel);
  520. getlabel(endexceptlabel);
  521. getlabel(lastonlabel);
  522. push_int (1); { push type of exceptionframe }
  523. emitcall('FPC_PUSHEXCEPTADDR');
  524. emit_reg(A_PUSH,S_L,R_EAX);
  525. emitcall('FPC_SETJMP');
  526. emit_reg(A_PUSH,S_L,R_EAX);
  527. emit_reg_reg(A_TEST,S_L,R_EAX,R_EAX);
  528. emitjmp(C_NE,exceptlabel);
  529. { try code }
  530. secondpass(p^.left);
  531. if codegenerror then
  532. exit;
  533. emitlab(exceptlabel);
  534. emitcall('FPC_POPADDRSTACK');
  535. emit_reg(A_POP,S_L,R_EAX);
  536. emit_reg_reg(A_TEST,S_L,R_EAX,R_EAX);
  537. emitjmp(C_E,endexceptlabel);
  538. emitlab(doexceptlabel);
  539. if assigned(p^.right) then
  540. secondpass(p^.right);
  541. emitlab(lastonlabel);
  542. { default handling }
  543. if assigned(p^.t1) then
  544. begin
  545. { FPC_CATCHES must be called with
  546. 'default handler' flag (=-1)
  547. }
  548. push_int (-1);
  549. emitcall('FPC_CATCHES');
  550. secondpass(p^.t1);
  551. emitcall('FPC_POPOBJECTSTACK');
  552. end
  553. else
  554. emitcall('FPC_RERAISE');
  555. emitlab(endexceptlabel);
  556. freelabel(exceptlabel);
  557. freelabel(doexceptlabel);
  558. freelabel(endexceptlabel);
  559. freelabel(lastonlabel);
  560. endexceptlabel:=oldendexceptlabel;
  561. end;
  562. procedure secondon(var p : ptree);
  563. var
  564. nextonlabel : pasmlabel;
  565. ref : treference;
  566. begin
  567. getlabel(nextonlabel);
  568. { push the vmt }
  569. emit_sym(A_PUSH,S_L,
  570. newasmsymbol(p^.excepttype^.vmt_mangledname));
  571. emitcall('FPC_CATCHES');
  572. emit_reg_reg(A_TEST,S_L,R_EAX,R_EAX);
  573. emitjmp(C_E,nextonlabel);
  574. ref.symbol:=nil;
  575. gettempofsizereference(4,ref);
  576. { what a hack ! }
  577. if assigned(p^.exceptsymtable) then
  578. pvarsym(p^.exceptsymtable^.symindex^.first)^.address:=ref.offset;
  579. emit_reg_ref(A_MOV,S_L,
  580. R_EAX,newreference(ref));
  581. if assigned(p^.right) then
  582. secondpass(p^.right);
  583. emit_ref(A_PUSH,S_L,
  584. newreference(ref));
  585. emitcall('FPC_DESTROYEXCEPTION');
  586. emitcall('FPC_POPOBJECTSTACK');
  587. { clear some stuff }
  588. ungetiftemp(ref);
  589. emitjmp(C_None,endexceptlabel);
  590. emitlab(nextonlabel);
  591. { next on node }
  592. if assigned(p^.left) then
  593. secondpass(p^.left);
  594. end;
  595. {*****************************************************************************
  596. SecondTryFinally
  597. *****************************************************************************}
  598. procedure secondtryfinally(var p : ptree);
  599. var
  600. finallylabel,noreraiselabel : pasmlabel;
  601. oldaktexitlabel,exitfinallylabel : pasmlabel;
  602. oldaktexit2label : pasmlabel;
  603. begin
  604. { we modify EAX }
  605. usedinproc:=usedinproc or ($80 shr byte(R_EAX));
  606. getlabel(finallylabel);
  607. getlabel(noreraiselabel);
  608. oldaktexitlabel:=aktexitlabel;
  609. oldaktexit2label:=aktexit2label;
  610. getlabel(exitfinallylabel);
  611. aktexitlabel:=exitfinallylabel;
  612. aktexit2label:=exitfinallylabel;
  613. push_int(1); { Type of stack-frame must be pushed}
  614. emitcall('FPC_PUSHEXCEPTADDR');
  615. emit_reg(A_PUSH,S_L,R_EAX);
  616. emitcall('FPC_SETJMP');
  617. emit_reg(A_PUSH,S_L,R_EAX);
  618. emit_reg_reg(A_TEST,S_L,R_EAX,R_EAX);
  619. emitjmp(C_NE,finallylabel);
  620. { try code }
  621. secondpass(p^.left);
  622. if codegenerror then
  623. exit;
  624. emitlab(finallylabel);
  625. emitcall('FPC_POPADDRSTACK');
  626. { finally code }
  627. secondpass(p^.right);
  628. if codegenerror then
  629. exit;
  630. emit_reg(A_POP,S_L,R_EAX);
  631. emit_reg_reg(A_TEST,S_L,R_EAX,R_EAX);
  632. emitjmp(C_E,noreraiselabel);
  633. emit_reg(A_DEC,S_L,R_EAX);
  634. emitjmp(C_NE,oldaktexitlabel);
  635. emitcall('FPC_RERAISE');
  636. { reraise never returns ! }
  637. emitlab(exitfinallylabel);
  638. { do some magic for exit in the try block }
  639. emit_reg(A_POP,S_L,R_EAX);
  640. emit_const(A_PUSH,S_L,2);
  641. emitjmp(C_NONE,finallylabel);
  642. emitlab(noreraiselabel);
  643. aktexitlabel:=oldaktexitlabel;
  644. aktexit2label:=oldaktexit2label;
  645. end;
  646. {*****************************************************************************
  647. SecondFail
  648. *****************************************************************************}
  649. procedure secondfail(var p : ptree);
  650. {var
  651. hp : preference;
  652. nofreememcall, afterfreememcall : pasmlabel; }
  653. begin
  654. (* { check if getmem was called :
  655. VMT at 8(%ebp) is set to -1 after call to getmem PM }
  656. { also reset to zero in the stack }
  657. getlabel(nofreememcall);
  658. getlabel(afterfreememcall);
  659. new(hp);
  660. reset_reference(hp^);
  661. hp^.offset:=8;
  662. hp^.base:=procinfo.framepointer;
  663. emit_const_ref(A_CMP,S_L,-1,hp);
  664. emitjmp(C_NE,nofreememcall);
  665. new(hp);
  666. reset_reference(hp^);
  667. hp^.offset:=procinfo._class^.vmt_offset;
  668. hp^.base:=R_ESI;
  669. emit_ref_reg(A_MOV,S_L,hp,R_EDI);
  670. new(hp);
  671. reset_reference(hp^);
  672. hp^.base:=R_EDI;
  673. {hp^.offset:=0; done in reset_reference }
  674. emit_ref(A_PUSH,S_L,hp);
  675. new(hp);
  676. reset_reference(hp^);
  677. hp^.offset:=procinfo.ESI_offset;
  678. hp^.base:=procinfo.framepointer;
  679. emit_ref_reg(A_LEA,S_L,hp,R_EDI);
  680. emit_reg(A_PUSH,S_L,R_EDI);
  681. emitcall('FPC_FREEMEM');
  682. emitjmp(C_None,afterfreememcall);
  683. emitlab(nofreememcall);
  684. { reset VMT field for static object }
  685. new(hp);
  686. reset_reference(hp^);
  687. hp^.offset:=procinfo._class^.vmt_offset;
  688. hp^.base:=R_ESI;
  689. emit_const_ref(A_MOV,S_L,0,hp);
  690. emitlab(afterfreememcall);
  691. emit_reg_reg(A_XOR,S_L,R_ESI,R_ESI);
  692. { also reset to zero in the stack }
  693. new(hp);
  694. reset_reference(hp^);
  695. hp^.offset:=procinfo.ESI_offset;
  696. hp^.base:=procinfo.framepointer;
  697. emit_reg_ref(A_MOV,S_L,R_ESI,hp); *)
  698. emitjmp(C_None,faillabel);
  699. end;
  700. end.
  701. {
  702. $Log$
  703. Revision 1.46 1999-08-19 13:06:47 pierre
  704. * _FAIL will now free memory correctly
  705. and reset VMT field on static instances
  706. (not yet tested for classes, is it allowed ?)
  707. + emit_.... all variant defined here to avoid tons of
  708. exprasmlist^.concat(new(pai386,...) in cg386***
  709. Revision 1.45 1999/08/04 00:22:46 florian
  710. * renamed i386asm and i386base to cpuasm and cpubase
  711. Revision 1.44 1999/08/03 22:02:39 peter
  712. * moved bitmask constants to sets
  713. * some other type/const renamings
  714. Revision 1.43 1999/07/26 12:13:45 florian
  715. * exit in try..finally blocks needed a second fix
  716. * a raise in a try..finally lead into a endless loop, fixed
  717. Revision 1.42 1999/07/26 09:41:59 florian
  718. * bugs 494-496 fixed
  719. Revision 1.41 1999/07/05 20:13:09 peter
  720. * removed temp defines
  721. Revision 1.40 1999/06/14 00:43:35 peter
  722. * merged
  723. Revision 1.39.2.1 1999/06/14 00:39:29 peter
  724. * don't pop object stack in catches, because it's needed for reraise
  725. Revision 1.39 1999/05/27 19:44:12 peter
  726. * removed oldasm
  727. * plabel -> pasmlabel
  728. * -a switches to source writing automaticly
  729. * assembler readers OOPed
  730. * asmsymbol automaticly external
  731. * jumptables and other label fixes for asm readers
  732. Revision 1.38 1999/05/21 13:54:48 peter
  733. * NEWLAB for label as symbol
  734. Revision 1.37 1999/05/17 21:57:01 florian
  735. * new temporary ansistring handling
  736. Revision 1.36 1999/05/13 21:59:21 peter
  737. * removed oldppu code
  738. * warning if objpas is loaded from uses
  739. * first things for new deref writing
  740. Revision 1.35 1999/05/01 13:24:07 peter
  741. * merged nasm compiler
  742. * old asm moved to oldasm/
  743. Revision 1.34 1999/04/26 13:31:25 peter
  744. * release storenumber,double_checksum
  745. Revision 1.33 1999/04/21 09:43:29 peter
  746. * storenumber works
  747. * fixed some typos in double_checksum
  748. + incompatible types type1 and type2 message (with storenumber)
  749. Revision 1.32 1999/04/17 13:10:58 peter
  750. * fixed exit()
  751. Revision 1.31 1999/04/14 09:14:46 peter
  752. * first things to store the symbol/def number in the ppu
  753. Revision 1.30 1999/03/05 16:14:59 peter
  754. * fixed exit() with word/byte return
  755. Revision 1.29 1999/02/25 21:02:26 peter
  756. * ag386bin updates
  757. + coff writer
  758. Revision 1.28 1999/02/22 02:15:09 peter
  759. * updates for ag386bin
  760. Revision 1.27 1999/01/26 11:26:21 pierre
  761. * bug0152 for i:=1 to i-5 do (i-5) evaluated first
  762. Revision 1.26 1998/12/19 00:23:44 florian
  763. * ansistring memory leaks fixed
  764. Revision 1.25 1998/11/30 09:43:03 pierre
  765. * some range check bugs fixed (still not working !)
  766. + added DLL writing support for win32 (also accepts variables)
  767. + TempAnsi for code that could be used for Temporary ansi strings
  768. handling
  769. Revision 1.24 1998/11/18 15:44:09 peter
  770. * VALUEPARA for tp7 compatible value parameters
  771. Revision 1.23 1998/11/12 16:43:32 florian
  772. * functions with ansi strings as result didn't work, solved
  773. Revision 1.22 1998/10/29 15:42:44 florian
  774. + partial disposing of temp. ansistrings
  775. Revision 1.21 1998/10/26 22:58:16 florian
  776. * new introduded problem with classes fix, the parent class wasn't set
  777. correct, if the class was defined forward before
  778. Revision 1.20 1998/10/06 17:16:42 pierre
  779. * some memory leaks fixed (thanks to Peter for heaptrc !)
  780. Revision 1.19 1998/09/28 12:13:53 peter
  781. * fixed repeat continue until true;
  782. Revision 1.18 1998/09/26 15:03:04 florian
  783. * small problems with DOM and excpetions fixed (code generation
  784. of raise was wrong and self was sometimes destroyed :()
  785. Revision 1.17 1998/09/17 09:42:14 peter
  786. + pass_2 for cg386
  787. * Message() -> CGMessage() for pass_1/pass_2
  788. Revision 1.16 1998/09/14 10:43:48 peter
  789. * all internal RTL functions start with FPC_
  790. Revision 1.15 1998/09/04 08:41:39 peter
  791. * updated some error CGMessages
  792. Revision 1.14 1998/09/03 17:08:39 pierre
  793. * better lines for stabs
  794. (no scroll back to if before else part
  795. no return to case line at jump outside case)
  796. + source lines also if not in order
  797. Revision 1.13 1998/09/01 12:47:58 peter
  798. * use pdef^.size instead of orddef^.typ
  799. Revision 1.12 1998/08/28 10:56:58 peter
  800. * removed warnings
  801. Revision 1.11 1998/08/05 16:00:10 florian
  802. * some fixes for ansi strings
  803. Revision 1.10 1998/08/04 16:26:26 jonas
  804. * converted // comment to TP comment
  805. Revision 1.9 1998/07/31 11:36:34 michael
  806. Default exception handler also needs to call FPC_CATCHES
  807. Revision 1.8 1998/07/30 13:30:32 florian
  808. * final implemenation of exception support, maybe it needs
  809. some fixes :)
  810. Revision 1.7 1998/07/30 11:18:13 florian
  811. + first implementation of try ... except on .. do end;
  812. * limitiation of 65535 bytes parameters for cdecl removed
  813. Revision 1.6 1998/07/29 13:29:11 michael
  814. + Corrected try.. code. Type of exception fram is pushed
  815. Revision 1.5 1998/07/28 21:52:49 florian
  816. + implementation of raise and try..finally
  817. + some misc. exception stuff
  818. Revision 1.4 1998/07/24 22:16:53 florian
  819. * internal error 10 together with array access fixed. I hope
  820. that's the final fix.
  821. Revision 1.3 1998/06/25 08:48:08 florian
  822. * first version of rtti support
  823. Revision 1.2 1998/06/08 13:13:33 pierre
  824. + temporary variables now in temp_gen.pas unit
  825. because it is processor independent
  826. * mppc68k.bat modified to undefine i386 and support_mmx
  827. (which are defaults for i386)
  828. Revision 1.1 1998/06/05 17:44:12 peter
  829. * splitted cgi386
  830. }