cg68kflw.pas 27 KB

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