nflw.pas 27 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006
  1. {
  2. $Id$
  3. Copyright (c) 1998-2000 by Florian Klaempfl
  4. Type checking and register allocation for nodes that influence
  5. the flow
  6. This program is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 2 of the License, or
  9. (at your option) any later version.
  10. This program is distributed in the hope that it will be useful,
  11. but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. GNU General Public License for more details.
  14. You should have received a copy of the GNU General Public License
  15. along with this program; if not, write to the Free Software
  16. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  17. ****************************************************************************
  18. }
  19. unit nflw;
  20. {$i defines.inc}
  21. interface
  22. uses
  23. node,aasm,cpubase,symtable;
  24. type
  25. tloopnode = class(tbinarynode)
  26. t1,t2 : tnode;
  27. constructor create(tt : tnodetype;l,r,_t1,_t2 : tnode);virtual;
  28. destructor destroy;override;
  29. function getcopy : tnode;override;
  30. {$ifdef extdebug}
  31. procedure dowrite;override;
  32. {$endif extdebug}
  33. end;
  34. twhilerepeatnode = class(tloopnode)
  35. function pass_1 : tnode;override;
  36. end;
  37. tifnode = class(tloopnode)
  38. constructor create(l,r,_t1 : tnode);virtual;
  39. function pass_1 : tnode;override;
  40. end;
  41. tfornode = class(tloopnode)
  42. constructor create(l,r,_t1,_t2 : tnode;back : boolean);virtual;
  43. function pass_1 : tnode;override;
  44. end;
  45. texitnode = class(tunarynode)
  46. constructor create(l:tnode);virtual;
  47. function pass_1 : tnode;override;
  48. end;
  49. tbreaknode = class(tnode)
  50. constructor create;virtual;
  51. function pass_1 : tnode;override;
  52. end;
  53. tcontinuenode = class(tnode)
  54. constructor create;virtual;
  55. function pass_1 : tnode;override;
  56. end;
  57. tgotonode = class(tnode)
  58. labelnr : pasmlabel;
  59. labsym : plabelsym;
  60. constructor create(p : pasmlabel);virtual;
  61. function getcopy : tnode;override;
  62. function pass_1 : tnode;override;
  63. end;
  64. tlabelnode = class(tunarynode)
  65. labelnr : pasmlabel;
  66. exceptionblock : tnode;
  67. labsym : plabelsym;
  68. constructor create(p : pasmlabel;l:tnode);virtual;
  69. function getcopy : tnode;override;
  70. function pass_1 : tnode;override;
  71. end;
  72. traisenode = class(tbinarynode)
  73. frametree : tnode;
  74. constructor create(l,taddr,tframe:tnode);virtual;
  75. function getcopy : tnode;override;
  76. function pass_1 : tnode;override;
  77. end;
  78. ttryexceptnode = class(tloopnode)
  79. constructor create(l,r,_t1 : tnode);virtual;
  80. function pass_1 : tnode;override;
  81. end;
  82. ttryfinallynode = class(tbinarynode)
  83. constructor create(l,r:tnode);virtual;
  84. function pass_1 : tnode;override;
  85. end;
  86. tonnode = class(tbinarynode)
  87. exceptsymtable : psymtable;
  88. excepttype : pobjectdef;
  89. constructor create(l,r:tnode);virtual;
  90. destructor destroy;override;
  91. function pass_1 : tnode;override;
  92. function getcopy : tnode;override;
  93. end;
  94. tfailnode = class(tnode)
  95. constructor create;virtual;
  96. function pass_1: tnode;override;
  97. end;
  98. { for compatibilty }
  99. function genloopnode(t : tnodetype;l,r,n1 : tnode;back : boolean) : tnode;
  100. var
  101. cwhilerepeatnode : class of twhilerepeatnode;
  102. cifnode : class of tifnode;
  103. cfornode : class of tfornode;
  104. cexitnode : class of texitnode;
  105. cbreaknode : class of tbreaknode;
  106. ccontinuenode : class of tcontinuenode;
  107. cgotonode : class of tgotonode;
  108. clabelnode : class of tlabelnode;
  109. craisenode : class of traisenode;
  110. ctryexceptnode : class of ttryexceptnode;
  111. ctryfinallynode : class of ttryfinallynode;
  112. connode : class of tonnode;
  113. cfailnode : class of tfailnode;
  114. implementation
  115. uses
  116. globtype,systems,
  117. cutils,cobjects,verbose,globals,
  118. symconst,types,htypechk,pass_1,
  119. ncon,nmem,nld,ncnv,nbas
  120. {$ifdef newcg}
  121. ,tgobj
  122. ,tgcpu
  123. ,cgbase
  124. {$else newcg}
  125. ,hcodegen
  126. ,temp_gen
  127. {$ifdef i386}
  128. ,tgeni386
  129. {$endif}
  130. {$ifdef m68k}
  131. ,tgen68k
  132. {$endif m68k}
  133. {$endif newcg}
  134. ;
  135. function genloopnode(t : tnodetype;l,r,n1 : tnode;back : boolean) : tnode;
  136. var
  137. p : tnode;
  138. begin
  139. case t of
  140. ifn:
  141. p:=cifnode.create(l,r,n1);
  142. repeatn:
  143. p:=cwhilerepeatnode.create(repeatn,l,r,n1,nil);
  144. whilen:
  145. p:=cwhilerepeatnode.create(whilen,l,r,n1,nil);
  146. forn:
  147. p:=cfornode.create(l,r,n1,nil,back);
  148. end;
  149. genloopnode:=p;
  150. end;
  151. {****************************************************************************
  152. TLOOPNODE
  153. *****************************************************************************}
  154. constructor tloopnode.create(tt : tnodetype;l,r,_t1,_t2 : tnode);
  155. begin
  156. inherited create(tt,l,r);
  157. t1:=_t1;
  158. t2:=_t2;
  159. set_file_line(l);
  160. end;
  161. destructor tloopnode.destroy;
  162. begin
  163. t1.free;
  164. t2.free;
  165. inherited destroy;
  166. end;
  167. function tloopnode.getcopy : tnode;
  168. var
  169. p : tloopnode;
  170. begin
  171. p:=tloopnode(inherited getcopy);
  172. if assigned(t1) then
  173. p.t1:=t1.getcopy
  174. else
  175. p.t1:=nil;
  176. if assigned(t2) then
  177. p.t2:=t2.getcopy
  178. else
  179. p.t2:=nil;
  180. getcopy:=p;
  181. end;
  182. {$ifdef extdebug}
  183. procedure tloopnode.dowrite;
  184. begin
  185. inherited dowrite;
  186. writenodeindention:=writenodeindention+' ';
  187. writenode(t1);
  188. writenode(t2);
  189. delete(writenodeindention,1,4);
  190. end;
  191. {$endif extdebug}
  192. {****************************************************************************
  193. TWHILEREPEATNODE
  194. *****************************************************************************}
  195. function twhilerepeatnode.pass_1 : tnode;
  196. var
  197. old_t_times : longint;
  198. begin
  199. pass_1:=nil;
  200. old_t_times:=t_times;
  201. { calc register weight }
  202. if not(cs_littlesize in aktglobalswitches ) then
  203. t_times:=t_times*8;
  204. {$ifdef newcg}
  205. tg.cleartempgen;
  206. {$else newcg}
  207. cleartempgen;
  208. {$endif newcg}
  209. firstpass(left);
  210. set_varstate(left,true);
  211. if codegenerror then
  212. exit;
  213. if not is_boolean(left.resulttype) then
  214. begin
  215. CGMessage(type_e_mismatch);
  216. exit;
  217. end;
  218. registers32:=left.registers32;
  219. registersfpu:=left.registersfpu;
  220. {$ifdef SUPPORT_MMX}
  221. registersmmx:=left.registersmmx;
  222. {$endif SUPPORT_MMX}
  223. { loop instruction }
  224. if assigned(right) then
  225. begin
  226. {$ifdef newcg}
  227. tg.cleartempgen;
  228. {$else newcg}
  229. cleartempgen;
  230. {$endif newcg}
  231. firstpass(right);
  232. if codegenerror then
  233. exit;
  234. if registers32<right.registers32 then
  235. registers32:=right.registers32;
  236. if registersfpu<right.registersfpu then
  237. registersfpu:=right.registersfpu;
  238. {$ifdef SUPPORT_MMX}
  239. if registersmmx<right.registersmmx then
  240. registersmmx:=right.registersmmx;
  241. {$endif SUPPORT_MMX}
  242. end;
  243. t_times:=old_t_times;
  244. end;
  245. {*****************************************************************************
  246. TIFNODE
  247. *****************************************************************************}
  248. constructor tifnode.create(l,r,_t1 : tnode);
  249. begin
  250. inherited create(ifn,l,r,_t1,nil);
  251. end;
  252. function tifnode.pass_1 : tnode;
  253. var
  254. old_t_times : longint;
  255. hp : tnode;
  256. begin
  257. pass_1:=nil;
  258. old_t_times:=t_times;
  259. {$ifdef newcg}
  260. tg.cleartempgen;
  261. {$else newcg}
  262. cleartempgen;
  263. {$endif newcg}
  264. firstpass(left);
  265. set_varstate(left,true);
  266. { Only check type if no error, we can't leave here because
  267. the right also needs to be firstpassed }
  268. if not codegenerror then
  269. begin
  270. if not is_boolean(left.resulttype) then
  271. Message1(type_e_boolean_expr_expected,left.resulttype^.typename);
  272. end;
  273. registers32:=left.registers32;
  274. registersfpu:=left.registersfpu;
  275. {$ifdef SUPPORT_MMX}
  276. registersmmx:=left.registersmmx;
  277. {$endif SUPPORT_MMX}
  278. { determines registers weigths }
  279. if not(cs_littlesize in aktglobalswitches) then
  280. t_times:=t_times div 2;
  281. if t_times=0 then
  282. t_times:=1;
  283. { if path }
  284. if assigned(right) then
  285. begin
  286. {$ifdef newcg}
  287. tg.cleartempgen;
  288. {$else newcg}
  289. cleartempgen;
  290. {$endif newcg}
  291. firstpass(right);
  292. if registers32<right.registers32 then
  293. registers32:=right.registers32;
  294. if registersfpu<right.registersfpu then
  295. registersfpu:=right.registersfpu;
  296. {$ifdef SUPPORT_MMX}
  297. if registersmmx<right.registersmmx then
  298. registersmmx:=right.registersmmx;
  299. {$endif SUPPORT_MMX}
  300. end;
  301. { else path }
  302. if assigned(t1) then
  303. begin
  304. {$ifdef newcg}
  305. tg.cleartempgen;
  306. {$else newcg}
  307. cleartempgen;
  308. {$endif newcg}
  309. firstpass(t1);
  310. if registers32<t1.registers32 then
  311. registers32:=t1.registers32;
  312. if registersfpu<t1.registersfpu then
  313. registersfpu:=t1.registersfpu;
  314. {$ifdef SUPPORT_MMX}
  315. if registersmmx<t1.registersmmx then
  316. registersmmx:=t1.registersmmx;
  317. {$endif SUPPORT_MMX}
  318. end;
  319. { leave if we've got an error in one of the paths }
  320. if codegenerror then
  321. exit;
  322. if left.nodetype=ordconstn then
  323. begin
  324. { optimize }
  325. if tordconstnode(left).value=1 then
  326. begin
  327. hp:=right;
  328. right:=nil;
  329. { we cannot set p to nil !!! }
  330. if assigned(hp) then
  331. pass_1:=hp
  332. else
  333. pass_1:=cnothingnode.create;
  334. end
  335. else
  336. begin
  337. hp:=t1;
  338. t1:=nil;
  339. { we cannot set p to nil !!! }
  340. if assigned(hp) then
  341. pass_1:=hp
  342. else
  343. pass_1:=cnothingnode.create;
  344. end;
  345. end;
  346. t_times:=old_t_times;
  347. end;
  348. {*****************************************************************************
  349. TFORNODE
  350. *****************************************************************************}
  351. constructor tfornode.create(l,r,_t1,_t2 : tnode;back : boolean);
  352. begin
  353. inherited create(forn,l,r,_t1,_t2);
  354. if back then
  355. include(flags,nf_backward);
  356. end;
  357. function tfornode.pass_1 : tnode;
  358. var
  359. old_t_times : longint;
  360. hp : tnode;
  361. begin
  362. result:=nil;
  363. { Calc register weight }
  364. old_t_times:=t_times;
  365. if not(cs_littlesize in aktglobalswitches) then
  366. t_times:=t_times*8;
  367. if left.nodetype<>assignn then
  368. begin
  369. CGMessage(cg_e_illegal_expression);
  370. exit;
  371. end;
  372. { save counter var }
  373. t2:=tassignmentnode(left).left.getcopy;
  374. {$ifdef newcg}
  375. tg.cleartempgen;
  376. {$else newcg}
  377. cleartempgen;
  378. {$endif newcg}
  379. firstpass(left);
  380. set_varstate(left,false);
  381. {$ifdef newcg}
  382. tg.cleartempgen;
  383. {$else newcg}
  384. cleartempgen;
  385. {$endif newcg}
  386. if assigned(t1) then
  387. begin
  388. firstpass(t1);
  389. if codegenerror then
  390. exit;
  391. end;
  392. registers32:=t1.registers32;
  393. registersfpu:=t1.registersfpu;
  394. {$ifdef SUPPORT_MMX}
  395. registersmmx:=left.registersmmx;
  396. {$endif SUPPORT_MMX}
  397. if left.registers32>registers32 then
  398. registers32:=left.registers32;
  399. if left.registersfpu>registersfpu then
  400. registersfpu:=left.registersfpu;
  401. {$ifdef SUPPORT_MMX}
  402. if left.registersmmx>registersmmx then
  403. registersmmx:=left.registersmmx;
  404. {$endif SUPPORT_MMX}
  405. { process count var }
  406. {$ifdef newcg}
  407. tg.cleartempgen;
  408. {$else newcg}
  409. cleartempgen;
  410. {$endif newcg}
  411. firstpass(t2);
  412. set_varstate(t2,true);
  413. if codegenerror then
  414. exit;
  415. { Check count var, record fields are also allowed in tp7 }
  416. hp:=t2;
  417. while (hp.nodetype=subscriptn) do
  418. hp:=tsubscriptnode(hp).left;
  419. { we need a simple loadn, but the load must be in a global symtable or
  420. in the same lexlevel }
  421. if (hp.nodetype=funcretn) or
  422. ((hp.nodetype=loadn) and
  423. ((tloadnode(hp).symtable^.symtablelevel<=1) or
  424. (tloadnode(hp).symtable^.symtablelevel=lexlevel))) then
  425. begin
  426. if tloadnode(hp).symtableentry^.typ=varsym then
  427. pvarsym(tloadnode(hp).symtableentry)^.varstate:=vs_used;
  428. if (not(is_ordinal(t2.resulttype)) or is_64bitint(t2.resulttype)) then
  429. CGMessagePos(hp.fileinfo,type_e_ordinal_expr_expected);
  430. end
  431. else
  432. CGMessagePos(hp.fileinfo,cg_e_illegal_count_var);
  433. if t2.registers32>registers32 then
  434. registers32:=t2.registers32;
  435. if t2.registersfpu>registersfpu then
  436. registersfpu:=t2.registersfpu;
  437. {$ifdef SUPPORT_MMX}
  438. if t2.registersmmx>registersmmx then
  439. registersmmx:=t2.registersmmx;
  440. {$endif SUPPORT_MMX}
  441. {$ifdef newcg}
  442. tg.cleartempgen;
  443. {$else newcg}
  444. cleartempgen;
  445. {$endif newcg}
  446. firstpass(right);
  447. set_varstate(right,true);
  448. if right.nodetype<>ordconstn then
  449. begin
  450. right:=gentypeconvnode(right,t2.resulttype);
  451. {$ifdef newcg}
  452. tg.cleartempgen;
  453. {$else newcg}
  454. cleartempgen;
  455. {$endif newcg}
  456. firstpass(right);
  457. end;
  458. if right.registers32>registers32 then
  459. registers32:=right.registers32;
  460. if right.registersfpu>registersfpu then
  461. registersfpu:=right.registersfpu;
  462. {$ifdef SUPPORT_MMX}
  463. if right.registersmmx>registersmmx then
  464. registersmmx:=right.registersmmx;
  465. {$endif SUPPORT_MMX}
  466. { we need at least one register for comparisons PM }
  467. if registers32=0 then
  468. inc(registers32);
  469. t_times:=old_t_times;
  470. end;
  471. {*****************************************************************************
  472. TEXITNODE
  473. *****************************************************************************}
  474. constructor texitnode.create(l:tnode);
  475. begin
  476. inherited create(exitn,l);
  477. end;
  478. function texitnode.pass_1 : tnode;
  479. var
  480. pt : tfuncretnode;
  481. begin
  482. pass_1:=nil;
  483. resulttype:=voiddef;
  484. if assigned(left) then
  485. begin
  486. firstpass(left);
  487. procinfo^.funcret_state:=vs_assigned;
  488. if codegenerror then
  489. exit;
  490. { Check the 2 types }
  491. left:=gentypeconvnode(left,procinfo^.returntype.def);
  492. firstpass(left);
  493. if ret_in_param(procinfo^.returntype.def) or procinfo^.no_fast_exit then
  494. begin
  495. pt:=cfuncretnode.create;
  496. pt.rettype.setdef(procinfo^.returntype.def);
  497. pt.funcretprocinfo:=procinfo;
  498. left:=cassignmentnode.create(pt,left);
  499. firstpass(left);
  500. end;
  501. registers32:=left.registers32;
  502. registersfpu:=left.registersfpu;
  503. {$ifdef SUPPORT_MMX}
  504. registersmmx:=left.registersmmx;
  505. {$endif SUPPORT_MMX}
  506. end;
  507. end;
  508. {*****************************************************************************
  509. TBREAKNODE
  510. *****************************************************************************}
  511. constructor tbreaknode.create;
  512. begin
  513. inherited create(breakn);
  514. end;
  515. function tbreaknode.pass_1 : tnode;
  516. begin
  517. result:=nil;
  518. end;
  519. {*****************************************************************************
  520. TCONTINUENODE
  521. *****************************************************************************}
  522. constructor tcontinuenode.create;
  523. begin
  524. inherited create(continuen);
  525. end;
  526. function tcontinuenode.pass_1 : tnode;
  527. begin
  528. result:=nil;
  529. end;
  530. {*****************************************************************************
  531. TGOTONODE
  532. *****************************************************************************}
  533. constructor tgotonode.create(p : pasmlabel);
  534. begin
  535. inherited create(goton);
  536. labelnr:=p;
  537. end;
  538. function tgotonode.pass_1 : tnode;
  539. begin
  540. pass_1:=nil;
  541. resulttype:=voiddef;
  542. end;
  543. function tgotonode.getcopy : tnode;
  544. var
  545. p : tgotonode;
  546. begin
  547. p:=tgotonode(inherited getcopy);
  548. p.labelnr:=labelnr;
  549. p.labsym:=labsym;
  550. result:=p;
  551. end;
  552. {*****************************************************************************
  553. TLABELNODE
  554. *****************************************************************************}
  555. constructor tlabelnode.create(p : pasmlabel;l:tnode);
  556. begin
  557. inherited create(labeln,l);
  558. labelnr:=p;
  559. exceptionblock:=nil;
  560. labsym:=nil;
  561. end;
  562. function tlabelnode.pass_1 : tnode;
  563. begin
  564. pass_1:=nil;
  565. {$ifdef newcg}
  566. tg.cleartempgen;
  567. {$else newcg}
  568. cleartempgen;
  569. {$endif newcg}
  570. exceptionblock:=aktexceptblock;
  571. firstpass(left);
  572. registers32:=left.registers32;
  573. registersfpu:=left.registersfpu;
  574. {$ifdef SUPPORT_MMX}
  575. registersmmx:=left.registersmmx;
  576. {$endif SUPPORT_MMX}
  577. resulttype:=voiddef;
  578. end;
  579. function tlabelnode.getcopy : tnode;
  580. var
  581. p : tlabelnode;
  582. begin
  583. p:=tlabelnode(inherited getcopy);
  584. p.labelnr:=labelnr;
  585. p.exceptionblock:=exceptionblock;
  586. p.labsym:=labsym;
  587. result:=p;
  588. end;
  589. {*****************************************************************************
  590. TRAISENODE
  591. *****************************************************************************}
  592. constructor traisenode.create(l,taddr,tframe:tnode);
  593. begin
  594. inherited create(raisen,l,taddr);
  595. frametree:=tframe;
  596. end;
  597. function traisenode.getcopy : tnode;
  598. var
  599. n : traisenode;
  600. begin
  601. n:=traisenode(inherited getcopy);
  602. if assigned(frametree) then
  603. n.frametree:=frametree.getcopy
  604. else
  605. n.frametree:=nil;
  606. getcopy:=n;
  607. end;
  608. function traisenode.pass_1 : tnode;
  609. begin
  610. pass_1:=nil;
  611. resulttype:=voiddef;
  612. if assigned(left) then
  613. begin
  614. { first para must be a _class_ }
  615. firstpass(left);
  616. if assigned(left.resulttype) and
  617. ((left.resulttype^.deftype<>objectdef) or
  618. not(pobjectdef(left.resulttype)^.is_class)) then
  619. CGMessage(type_e_mismatch);
  620. set_varstate(left,true);
  621. if codegenerror then
  622. exit;
  623. { insert needed typeconvs for addr,frame }
  624. if assigned(right) then
  625. begin
  626. { addr }
  627. firstpass(right);
  628. right:=gentypeconvnode(right,s32bitdef);
  629. firstpass(right);
  630. if codegenerror then
  631. exit;
  632. { frame }
  633. if assigned(frametree) then
  634. begin
  635. firstpass(frametree);
  636. frametree:=gentypeconvnode(frametree,s32bitdef);
  637. firstpass(frametree);
  638. if codegenerror then
  639. exit;
  640. end;
  641. end;
  642. left_right_max;
  643. end;
  644. end;
  645. {*****************************************************************************
  646. TTRYEXCEPTNODE
  647. *****************************************************************************}
  648. constructor ttryexceptnode.create(l,r,_t1 : tnode);
  649. begin
  650. inherited create(tryexceptn,l,r,_t1,nil);
  651. end;
  652. function ttryexceptnode.pass_1 : tnode;
  653. var
  654. oldexceptblock : tnode;
  655. begin
  656. pass_1:=nil;
  657. {$ifdef newcg}
  658. tg.cleartempgen;
  659. {$else newcg}
  660. cleartempgen;
  661. {$endif newcg}
  662. oldexceptblock:=aktexceptblock;
  663. aktexceptblock:=left;
  664. firstpass(left);
  665. aktexceptblock:=oldexceptblock;
  666. { on statements }
  667. if assigned(right) then
  668. begin
  669. {$ifdef newcg}
  670. tg.cleartempgen;
  671. {$else newcg}
  672. cleartempgen;
  673. {$endif newcg}
  674. oldexceptblock:=aktexceptblock;
  675. aktexceptblock:=right;
  676. firstpass(right);
  677. aktexceptblock:=oldexceptblock;
  678. registers32:=max(registers32,right.registers32);
  679. registersfpu:=max(registersfpu,right.registersfpu);
  680. {$ifdef SUPPORT_MMX}
  681. registersmmx:=max(registersmmx,right.registersmmx);
  682. {$endif SUPPORT_MMX}
  683. end;
  684. { else block }
  685. if assigned(t1) then
  686. begin
  687. oldexceptblock:=aktexceptblock;
  688. aktexceptblock:=t1;
  689. firstpass(t1);
  690. aktexceptblock:=oldexceptblock;
  691. registers32:=max(registers32,t1.registers32);
  692. registersfpu:=max(registersfpu,t1.registersfpu);
  693. {$ifdef SUPPORT_MMX}
  694. registersmmx:=max(registersmmx,t1.registersmmx);
  695. {$endif SUPPORT_MMX}
  696. end;
  697. end;
  698. {*****************************************************************************
  699. TTRYFINALLYNODE
  700. *****************************************************************************}
  701. constructor ttryfinallynode.create(l,r:tnode);
  702. begin
  703. inherited create(tryfinallyn,l,r);
  704. end;
  705. function ttryfinallynode.pass_1 : tnode;
  706. var
  707. oldexceptblock : tnode;
  708. begin
  709. pass_1:=nil;
  710. resulttype:=voiddef;
  711. {$ifdef newcg}
  712. tg.cleartempgen;
  713. {$else newcg}
  714. cleartempgen;
  715. {$endif newcg}
  716. oldexceptblock:=aktexceptblock;
  717. aktexceptblock:=left;
  718. firstpass(left);
  719. aktexceptblock:=oldexceptblock;
  720. set_varstate(left,true);
  721. {$ifdef newcg}
  722. tg.cleartempgen;
  723. {$else newcg}
  724. cleartempgen;
  725. {$endif newcg}
  726. oldexceptblock:=aktexceptblock;
  727. aktexceptblock:=right;
  728. firstpass(right);
  729. aktexceptblock:=oldexceptblock;
  730. set_varstate(right,true);
  731. if codegenerror then
  732. exit;
  733. left_right_max;
  734. end;
  735. {*****************************************************************************
  736. TONNODE
  737. *****************************************************************************}
  738. constructor tonnode.create(l,r:tnode);
  739. begin
  740. inherited create(onn,l,r);
  741. exceptsymtable:=nil;
  742. excepttype:=nil;
  743. end;
  744. destructor tonnode.destroy;
  745. begin
  746. if assigned(exceptsymtable) then
  747. dispose(exceptsymtable,done);
  748. inherited destroy;
  749. end;
  750. function tonnode.getcopy : tnode;
  751. var
  752. n : tonnode;
  753. begin
  754. n:=tonnode(inherited getcopy);
  755. n.exceptsymtable:=exceptsymtable;
  756. n.excepttype:=excepttype;
  757. result:=n;
  758. end;
  759. function tonnode.pass_1 : tnode;
  760. var
  761. oldexceptblock : tnode;
  762. begin
  763. pass_1:=nil;
  764. { that's really an example procedure for a firstpass :) }
  765. if (excepttype^.deftype<>objectdef) or
  766. not(pobjectdef(excepttype)^.is_class) then
  767. CGMessage(type_e_mismatch);
  768. {$ifdef newcg}
  769. tg.cleartempgen;
  770. {$else newcg}
  771. cleartempgen;
  772. {$endif newcg}
  773. resulttype:=voiddef;
  774. registers32:=0;
  775. registersfpu:=0;
  776. {$ifdef SUPPORT_MMX}
  777. registersmmx:=0;
  778. {$endif SUPPORT_MMX}
  779. if assigned(left) then
  780. begin
  781. firstpass(left);
  782. registers32:=left.registers32;
  783. registersfpu:=left.registersfpu;
  784. {$ifdef SUPPORT_MMX}
  785. registersmmx:=left.registersmmx;
  786. {$endif SUPPORT_MMX}
  787. end;
  788. {$ifdef newcg}
  789. tg.cleartempgen;
  790. {$else newcg}
  791. cleartempgen;
  792. {$endif newcg}
  793. if assigned(right) then
  794. begin
  795. oldexceptblock:=aktexceptblock;
  796. aktexceptblock:=right;
  797. firstpass(right);
  798. aktexceptblock:=oldexceptblock;
  799. registers32:=max(registers32,right.registers32);
  800. registersfpu:=max(registersfpu,right.registersfpu);
  801. {$ifdef SUPPORT_MMX}
  802. registersmmx:=max(registersmmx,right.registersmmx);
  803. {$endif SUPPORT_MMX}
  804. end;
  805. end;
  806. {*****************************************************************************
  807. TONNODE
  808. *****************************************************************************}
  809. constructor tfailnode.create;
  810. begin
  811. inherited create(failn);
  812. end;
  813. function tfailnode.pass_1 : tnode;
  814. begin
  815. pass_1:=nil;
  816. end;
  817. begin
  818. cwhilerepeatnode:=twhilerepeatnode;
  819. cifnode:=tifnode;
  820. cfornode:=tfornode;
  821. cexitnode:=texitnode;
  822. cgotonode:=tgotonode;
  823. clabelnode:=tlabelnode;
  824. craisenode:=traisenode;
  825. ctryexceptnode:=ttryexceptnode;
  826. ctryfinallynode:=ttryfinallynode;
  827. connode:=tonnode;
  828. cfailnode:=tfailnode;
  829. end.
  830. {
  831. $Log$
  832. Revision 1.7 2000-10-14 21:52:55 peter
  833. * fixed memory leaks
  834. Revision 1.6 2000/10/14 10:14:50 peter
  835. * moehrendorf oct 2000 rewrite
  836. Revision 1.5 2000/10/01 19:48:24 peter
  837. * lot of compile updates for cg11
  838. Revision 1.4 2000/09/28 19:49:52 florian
  839. *** empty log message ***
  840. Revision 1.3 2000/09/24 21:15:34 florian
  841. * some errors fix to get more stuff compilable
  842. Revision 1.2 2000/09/24 15:06:19 peter
  843. * use defines.inc
  844. Revision 1.1 2000/09/22 22:46:03 florian
  845. + initial revision
  846. }