nflw.pas 27 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025
  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,verbose,globals,
  121. symconst,symtable,types,htypechk,pass_1,
  122. ncon,nmem,nld,ncnv,nbas,tgcpu,hcodegen
  123. {$ifdef newcg}
  124. ,tgobj
  125. ,cgbase
  126. {$else newcg}
  127. ,temp_gen
  128. {$endif newcg}
  129. ;
  130. function genloopnode(t : tnodetype;l,r,n1 : tnode;back : boolean) : tnode;
  131. var
  132. p : tnode;
  133. begin
  134. case t of
  135. ifn:
  136. p:=cifnode.create(l,r,n1);
  137. repeatn:
  138. p:=cwhilerepeatnode.create(repeatn,l,r,n1,nil);
  139. whilen:
  140. p:=cwhilerepeatnode.create(whilen,l,r,n1,nil);
  141. forn:
  142. p:=cfornode.create(l,r,n1,nil,back);
  143. end;
  144. genloopnode:=p;
  145. end;
  146. {****************************************************************************
  147. TLOOPNODE
  148. *****************************************************************************}
  149. constructor tloopnode.create(tt : tnodetype;l,r,_t1,_t2 : tnode);
  150. begin
  151. inherited create(tt,l,r);
  152. t1:=_t1;
  153. t2:=_t2;
  154. set_file_line(l);
  155. end;
  156. destructor tloopnode.destroy;
  157. begin
  158. t1.free;
  159. t2.free;
  160. inherited destroy;
  161. end;
  162. function tloopnode.getcopy : tnode;
  163. var
  164. p : tloopnode;
  165. begin
  166. p:=tloopnode(inherited getcopy);
  167. if assigned(t1) then
  168. p.t1:=t1.getcopy
  169. else
  170. p.t1:=nil;
  171. if assigned(t2) then
  172. p.t2:=t2.getcopy
  173. else
  174. p.t2:=nil;
  175. getcopy:=p;
  176. end;
  177. procedure tloopnode.insertintolist(l : tnodelist);
  178. begin
  179. end;
  180. {$ifdef extdebug}
  181. procedure tloopnode.dowrite;
  182. begin
  183. inherited dowrite;
  184. writenodeindention:=writenodeindention+' ';
  185. writenode(t1);
  186. writenode(t2);
  187. delete(writenodeindention,1,4);
  188. end;
  189. {$endif extdebug}
  190. {****************************************************************************
  191. TWHILEREPEATNODE
  192. *****************************************************************************}
  193. function twhilerepeatnode.pass_1 : tnode;
  194. var
  195. old_t_times : longint;
  196. begin
  197. pass_1:=nil;
  198. old_t_times:=t_times;
  199. { calc register weight }
  200. if not(cs_littlesize in aktglobalswitches ) then
  201. t_times:=t_times*8;
  202. {$ifdef newcg}
  203. tg.cleartempgen;
  204. {$else newcg}
  205. cleartempgen;
  206. {$endif newcg}
  207. firstpass(left);
  208. set_varstate(left,true);
  209. if codegenerror then
  210. exit;
  211. if not is_boolean(left.resulttype) then
  212. begin
  213. CGMessage(type_e_mismatch);
  214. exit;
  215. end;
  216. registers32:=left.registers32;
  217. registersfpu:=left.registersfpu;
  218. {$ifdef SUPPORT_MMX}
  219. registersmmx:=left.registersmmx;
  220. {$endif SUPPORT_MMX}
  221. { loop instruction }
  222. if assigned(right) then
  223. begin
  224. {$ifdef newcg}
  225. tg.cleartempgen;
  226. {$else newcg}
  227. cleartempgen;
  228. {$endif newcg}
  229. firstpass(right);
  230. if codegenerror then
  231. exit;
  232. if registers32<right.registers32 then
  233. registers32:=right.registers32;
  234. if registersfpu<right.registersfpu then
  235. registersfpu:=right.registersfpu;
  236. {$ifdef SUPPORT_MMX}
  237. if registersmmx<right.registersmmx then
  238. registersmmx:=right.registersmmx;
  239. {$endif SUPPORT_MMX}
  240. end;
  241. t_times:=old_t_times;
  242. end;
  243. {*****************************************************************************
  244. TIFNODE
  245. *****************************************************************************}
  246. constructor tifnode.create(l,r,_t1 : tnode);
  247. begin
  248. inherited create(ifn,l,r,_t1,nil);
  249. end;
  250. function tifnode.pass_1 : tnode;
  251. var
  252. old_t_times : longint;
  253. hp : tnode;
  254. begin
  255. pass_1:=nil;
  256. old_t_times:=t_times;
  257. {$ifdef newcg}
  258. tg.cleartempgen;
  259. {$else newcg}
  260. cleartempgen;
  261. {$endif newcg}
  262. firstpass(left);
  263. set_varstate(left,true);
  264. { Only check type if no error, we can't leave here because
  265. the right also needs to be firstpassed }
  266. if not codegenerror then
  267. begin
  268. if not is_boolean(left.resulttype) then
  269. Message1(type_e_boolean_expr_expected,left.resulttype^.typename);
  270. end;
  271. registers32:=left.registers32;
  272. registersfpu:=left.registersfpu;
  273. {$ifdef SUPPORT_MMX}
  274. registersmmx:=left.registersmmx;
  275. {$endif SUPPORT_MMX}
  276. { determines registers weigths }
  277. if not(cs_littlesize in aktglobalswitches) then
  278. t_times:=t_times div 2;
  279. if t_times=0 then
  280. t_times:=1;
  281. { if path }
  282. if assigned(right) then
  283. begin
  284. {$ifdef newcg}
  285. tg.cleartempgen;
  286. {$else newcg}
  287. cleartempgen;
  288. {$endif newcg}
  289. firstpass(right);
  290. if registers32<right.registers32 then
  291. registers32:=right.registers32;
  292. if registersfpu<right.registersfpu then
  293. registersfpu:=right.registersfpu;
  294. {$ifdef SUPPORT_MMX}
  295. if registersmmx<right.registersmmx then
  296. registersmmx:=right.registersmmx;
  297. {$endif SUPPORT_MMX}
  298. end;
  299. { else path }
  300. if assigned(t1) then
  301. begin
  302. {$ifdef newcg}
  303. tg.cleartempgen;
  304. {$else newcg}
  305. cleartempgen;
  306. {$endif newcg}
  307. firstpass(t1);
  308. if registers32<t1.registers32 then
  309. registers32:=t1.registers32;
  310. if registersfpu<t1.registersfpu then
  311. registersfpu:=t1.registersfpu;
  312. {$ifdef SUPPORT_MMX}
  313. if registersmmx<t1.registersmmx then
  314. registersmmx:=t1.registersmmx;
  315. {$endif SUPPORT_MMX}
  316. end;
  317. { leave if we've got an error in one of the paths }
  318. if codegenerror then
  319. exit;
  320. if left.nodetype=ordconstn then
  321. begin
  322. { optimize }
  323. if tordconstnode(left).value=1 then
  324. begin
  325. hp:=right;
  326. right:=nil;
  327. { we cannot set p to nil !!! }
  328. if assigned(hp) then
  329. pass_1:=hp
  330. else
  331. pass_1:=cnothingnode.create;
  332. end
  333. else
  334. begin
  335. hp:=t1;
  336. t1:=nil;
  337. { we cannot set p to nil !!! }
  338. if assigned(hp) then
  339. pass_1:=hp
  340. else
  341. pass_1:=cnothingnode.create;
  342. end;
  343. end;
  344. t_times:=old_t_times;
  345. end;
  346. {*****************************************************************************
  347. TFORNODE
  348. *****************************************************************************}
  349. constructor tfornode.create(l,r,_t1,_t2 : tnode;back : boolean);
  350. begin
  351. inherited create(forn,l,r,_t1,_t2);
  352. if back then
  353. include(flags,nf_backward);
  354. end;
  355. function tfornode.pass_1 : tnode;
  356. var
  357. old_t_times : longint;
  358. hp : tnode;
  359. begin
  360. result:=nil;
  361. { Calc register weight }
  362. old_t_times:=t_times;
  363. if not(cs_littlesize in aktglobalswitches) then
  364. t_times:=t_times*8;
  365. if left.nodetype<>assignn then
  366. begin
  367. CGMessage(cg_e_illegal_expression);
  368. exit;
  369. end;
  370. { save counter var }
  371. t2:=tassignmentnode(left).left.getcopy;
  372. {$ifdef newcg}
  373. tg.cleartempgen;
  374. {$else newcg}
  375. cleartempgen;
  376. {$endif newcg}
  377. firstpass(left);
  378. set_varstate(left,false);
  379. {$ifdef newcg}
  380. tg.cleartempgen;
  381. {$else newcg}
  382. cleartempgen;
  383. {$endif newcg}
  384. if assigned(t1) then
  385. begin
  386. firstpass(t1);
  387. if codegenerror then
  388. exit;
  389. end;
  390. registers32:=t1.registers32;
  391. registersfpu:=t1.registersfpu;
  392. {$ifdef SUPPORT_MMX}
  393. registersmmx:=left.registersmmx;
  394. {$endif SUPPORT_MMX}
  395. if left.registers32>registers32 then
  396. registers32:=left.registers32;
  397. if left.registersfpu>registersfpu then
  398. registersfpu:=left.registersfpu;
  399. {$ifdef SUPPORT_MMX}
  400. if left.registersmmx>registersmmx then
  401. registersmmx:=left.registersmmx;
  402. {$endif SUPPORT_MMX}
  403. { process count var }
  404. {$ifdef newcg}
  405. tg.cleartempgen;
  406. {$else newcg}
  407. cleartempgen;
  408. {$endif newcg}
  409. firstpass(t2);
  410. set_varstate(t2,true);
  411. if codegenerror then
  412. exit;
  413. { Check count var, record fields are also allowed in tp7 }
  414. hp:=t2;
  415. while (hp.nodetype=subscriptn) do
  416. hp:=tsubscriptnode(hp).left;
  417. { we need a simple loadn, but the load must be in a global symtable or
  418. in the same lexlevel }
  419. if (hp.nodetype=funcretn) or
  420. ((hp.nodetype=loadn) and
  421. ((tloadnode(hp).symtable^.symtablelevel<=1) or
  422. (tloadnode(hp).symtable^.symtablelevel=lexlevel))) then
  423. begin
  424. if tloadnode(hp).symtableentry^.typ=varsym then
  425. pvarsym(tloadnode(hp).symtableentry)^.varstate:=vs_used;
  426. if (not(is_ordinal(t2.resulttype)) or is_64bitint(t2.resulttype)) then
  427. CGMessagePos(hp.fileinfo,type_e_ordinal_expr_expected);
  428. end
  429. else
  430. CGMessagePos(hp.fileinfo,cg_e_illegal_count_var);
  431. if t2.registers32>registers32 then
  432. registers32:=t2.registers32;
  433. if t2.registersfpu>registersfpu then
  434. registersfpu:=t2.registersfpu;
  435. {$ifdef SUPPORT_MMX}
  436. if t2.registersmmx>registersmmx then
  437. registersmmx:=t2.registersmmx;
  438. {$endif SUPPORT_MMX}
  439. {$ifdef newcg}
  440. tg.cleartempgen;
  441. {$else newcg}
  442. cleartempgen;
  443. {$endif newcg}
  444. firstpass(right);
  445. set_varstate(right,true);
  446. if right.nodetype<>ordconstn then
  447. begin
  448. right:=gentypeconvnode(right,t2.resulttype);
  449. {$ifdef newcg}
  450. tg.cleartempgen;
  451. {$else newcg}
  452. cleartempgen;
  453. {$endif newcg}
  454. firstpass(right);
  455. end;
  456. if right.registers32>registers32 then
  457. registers32:=right.registers32;
  458. if right.registersfpu>registersfpu then
  459. registersfpu:=right.registersfpu;
  460. {$ifdef SUPPORT_MMX}
  461. if right.registersmmx>registersmmx then
  462. registersmmx:=right.registersmmx;
  463. {$endif SUPPORT_MMX}
  464. { we need at least one register for comparisons PM }
  465. if registers32=0 then
  466. inc(registers32);
  467. t_times:=old_t_times;
  468. end;
  469. {*****************************************************************************
  470. TEXITNODE
  471. *****************************************************************************}
  472. constructor texitnode.create(l:tnode);
  473. begin
  474. inherited create(exitn,l);
  475. end;
  476. function texitnode.pass_1 : tnode;
  477. var
  478. pt : tfuncretnode;
  479. begin
  480. pass_1:=nil;
  481. resulttype:=voiddef;
  482. if assigned(left) then
  483. begin
  484. firstpass(left);
  485. procinfo^.funcret_state:=vs_assigned;
  486. if codegenerror then
  487. exit;
  488. { Check the 2 types }
  489. left:=gentypeconvnode(left,procinfo^.returntype.def);
  490. firstpass(left);
  491. if ret_in_param(procinfo^.returntype.def) or procinfo^.no_fast_exit then
  492. begin
  493. pt:=cfuncretnode.create;
  494. pt.rettype.setdef(procinfo^.returntype.def);
  495. pt.funcretprocinfo:=procinfo;
  496. left:=cassignmentnode.create(pt,left);
  497. firstpass(left);
  498. end;
  499. registers32:=left.registers32;
  500. registersfpu:=left.registersfpu;
  501. {$ifdef SUPPORT_MMX}
  502. registersmmx:=left.registersmmx;
  503. {$endif SUPPORT_MMX}
  504. end;
  505. end;
  506. {*****************************************************************************
  507. TBREAKNODE
  508. *****************************************************************************}
  509. constructor tbreaknode.create;
  510. begin
  511. inherited create(breakn);
  512. end;
  513. function tbreaknode.pass_1 : tnode;
  514. begin
  515. result:=nil;
  516. end;
  517. {*****************************************************************************
  518. TCONTINUENODE
  519. *****************************************************************************}
  520. constructor tcontinuenode.create;
  521. begin
  522. inherited create(continuen);
  523. end;
  524. function tcontinuenode.pass_1 : tnode;
  525. begin
  526. result:=nil;
  527. end;
  528. {*****************************************************************************
  529. TGOTONODE
  530. *****************************************************************************}
  531. constructor tgotonode.create(p : pasmlabel);
  532. begin
  533. inherited create(goton);
  534. labelnr:=p;
  535. end;
  536. function tgotonode.pass_1 : tnode;
  537. begin
  538. pass_1:=nil;
  539. resulttype:=voiddef;
  540. end;
  541. function tgotonode.getcopy : tnode;
  542. var
  543. p : tgotonode;
  544. begin
  545. p:=tgotonode(inherited getcopy);
  546. p.labelnr:=labelnr;
  547. p.labsym:=labsym;
  548. result:=p;
  549. end;
  550. {*****************************************************************************
  551. TLABELNODE
  552. *****************************************************************************}
  553. constructor tlabelnode.create(p : pasmlabel;l:tnode);
  554. begin
  555. inherited create(labeln,l);
  556. labelnr:=p;
  557. exceptionblock:=nil;
  558. labsym:=nil;
  559. end;
  560. function tlabelnode.pass_1 : tnode;
  561. begin
  562. pass_1:=nil;
  563. {$ifdef newcg}
  564. tg.cleartempgen;
  565. {$else newcg}
  566. cleartempgen;
  567. {$endif newcg}
  568. exceptionblock:=aktexceptblock;
  569. firstpass(left);
  570. registers32:=left.registers32;
  571. registersfpu:=left.registersfpu;
  572. {$ifdef SUPPORT_MMX}
  573. registersmmx:=left.registersmmx;
  574. {$endif SUPPORT_MMX}
  575. resulttype:=voiddef;
  576. end;
  577. function tlabelnode.getcopy : tnode;
  578. var
  579. p : tlabelnode;
  580. begin
  581. p:=tlabelnode(inherited getcopy);
  582. p.labelnr:=labelnr;
  583. p.exceptionblock:=exceptionblock;
  584. p.labsym:=labsym;
  585. result:=p;
  586. end;
  587. {*****************************************************************************
  588. TRAISENODE
  589. *****************************************************************************}
  590. constructor traisenode.create(l,taddr,tframe:tnode);
  591. begin
  592. inherited create(raisen,l,taddr);
  593. frametree:=tframe;
  594. end;
  595. function traisenode.getcopy : tnode;
  596. var
  597. n : traisenode;
  598. begin
  599. n:=traisenode(inherited getcopy);
  600. if assigned(frametree) then
  601. n.frametree:=frametree.getcopy
  602. else
  603. n.frametree:=nil;
  604. getcopy:=n;
  605. end;
  606. procedure traisenode.insertintolist(l : tnodelist);
  607. begin
  608. end;
  609. function traisenode.pass_1 : tnode;
  610. begin
  611. pass_1:=nil;
  612. resulttype:=voiddef;
  613. if assigned(left) then
  614. begin
  615. { first para must be a _class_ }
  616. firstpass(left);
  617. if assigned(left.resulttype) and
  618. not(is_class(left.resulttype)) 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 not(is_class(excepttype)) then
  766. CGMessage(type_e_mismatch);
  767. {$ifdef newcg}
  768. tg.cleartempgen;
  769. {$else newcg}
  770. cleartempgen;
  771. {$endif newcg}
  772. resulttype:=voiddef;
  773. registers32:=0;
  774. registersfpu:=0;
  775. {$ifdef SUPPORT_MMX}
  776. registersmmx:=0;
  777. {$endif SUPPORT_MMX}
  778. if assigned(left) then
  779. begin
  780. firstpass(left);
  781. registers32:=left.registers32;
  782. registersfpu:=left.registersfpu;
  783. {$ifdef SUPPORT_MMX}
  784. registersmmx:=left.registersmmx;
  785. {$endif SUPPORT_MMX}
  786. end;
  787. {$ifdef newcg}
  788. tg.cleartempgen;
  789. {$else newcg}
  790. cleartempgen;
  791. {$endif newcg}
  792. if assigned(right) then
  793. begin
  794. oldexceptblock:=aktexceptblock;
  795. aktexceptblock:=right;
  796. firstpass(right);
  797. aktexceptblock:=oldexceptblock;
  798. registers32:=max(registers32,right.registers32);
  799. registersfpu:=max(registersfpu,right.registersfpu);
  800. {$ifdef SUPPORT_MMX}
  801. registersmmx:=max(registersmmx,right.registersmmx);
  802. {$endif SUPPORT_MMX}
  803. end;
  804. end;
  805. {*****************************************************************************
  806. TONNODE
  807. *****************************************************************************}
  808. constructor tfailnode.create;
  809. begin
  810. inherited create(failn);
  811. end;
  812. function tfailnode.pass_1 : tnode;
  813. begin
  814. pass_1:=nil;
  815. end;
  816. begin
  817. cwhilerepeatnode:=twhilerepeatnode;
  818. cifnode:=tifnode;
  819. cfornode:=tfornode;
  820. cexitnode:=texitnode;
  821. cgotonode:=tgotonode;
  822. clabelnode:=tlabelnode;
  823. craisenode:=traisenode;
  824. ctryexceptnode:=ttryexceptnode;
  825. ctryfinallynode:=ttryfinallynode;
  826. connode:=tonnode;
  827. cfailnode:=tfailnode;
  828. end.
  829. {
  830. $Log$
  831. Revision 1.11 2000-11-29 00:30:33 florian
  832. * unused units removed from uses clause
  833. * some changes for widestrings
  834. Revision 1.10 2000/11/04 14:25:20 florian
  835. + merged Attila's changes for interfaces, not tested yet
  836. Revision 1.9 2000/10/31 22:02:48 peter
  837. * symtable splitted, no real code changes
  838. Revision 1.8 2000/10/21 18:16:11 florian
  839. * a lot of changes:
  840. - basic dyn. array support
  841. - basic C++ support
  842. - some work for interfaces done
  843. ....
  844. Revision 1.7 2000/10/14 21:52:55 peter
  845. * fixed memory leaks
  846. Revision 1.6 2000/10/14 10:14:50 peter
  847. * moehrendorf oct 2000 rewrite
  848. Revision 1.5 2000/10/01 19:48:24 peter
  849. * lot of compile updates for cg11
  850. Revision 1.4 2000/09/28 19:49:52 florian
  851. *** empty log message ***
  852. Revision 1.3 2000/09/24 21:15:34 florian
  853. * some errors fix to get more stuff compilable
  854. Revision 1.2 2000/09/24 15:06:19 peter
  855. * use defines.inc
  856. Revision 1.1 2000/09/22 22:46:03 florian
  857. + initial revision
  858. }