nflw.pas 29 KB

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