nflw.pas 33 KB

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