cg68kflw.pas 28 KB

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