cg68kflw.pas 28 KB

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