nflw.pas 27 KB

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