nflw.pas 32 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 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 fpcdefs.inc}
  21. interface
  22. uses
  23. node,aasmbase,aasmtai,aasmcpu,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. twhilerepeatnodeclass = class of twhilerepeatnode;
  42. tifnode = class(tloopnode)
  43. constructor create(l,r,_t1 : tnode);virtual;
  44. function det_resulttype:tnode;override;
  45. function pass_1 : tnode;override;
  46. end;
  47. tifnodeclass = class of tifnode;
  48. tfornode = class(tloopnode)
  49. constructor create(l,r,_t1,_t2 : tnode;back : boolean);virtual;
  50. function det_resulttype:tnode;override;
  51. function pass_1 : tnode;override;
  52. end;
  53. tfornodeclass = class of tfornode;
  54. texitnode = class(tunarynode)
  55. constructor create(l:tnode);virtual;
  56. function det_resulttype:tnode;override;
  57. function pass_1 : tnode;override;
  58. end;
  59. texitnodeclass = class of texitnode;
  60. tbreaknode = class(tnode)
  61. constructor create;virtual;
  62. function det_resulttype:tnode;override;
  63. function pass_1 : tnode;override;
  64. end;
  65. tbreaknodeclass = class of tbreaknode;
  66. tcontinuenode = class(tnode)
  67. constructor create;virtual;
  68. function det_resulttype:tnode;override;
  69. function pass_1 : tnode;override;
  70. end;
  71. tcontinuenodeclass = class of tcontinuenode;
  72. tgotonode = class(tnode)
  73. labelnr : tasmlabel;
  74. labsym : tlabelsym;
  75. exceptionblock : integer;
  76. constructor create(p : tlabelsym);virtual;
  77. function getcopy : tnode;override;
  78. function det_resulttype:tnode;override;
  79. function pass_1 : tnode;override;
  80. function docompare(p: tnode): boolean; override;
  81. end;
  82. tgotonodeclass = class of tgotonode;
  83. tlabelnode = class(tunarynode)
  84. labelnr : tasmlabel;
  85. labsym : tlabelsym;
  86. exceptionblock : integer;
  87. constructor createcase(p : tasmlabel;l:tnode);virtual;
  88. constructor create(p : tlabelsym;l:tnode);virtual;
  89. function getcopy : tnode;override;
  90. function det_resulttype:tnode;override;
  91. function pass_1 : tnode;override;
  92. function docompare(p: tnode): boolean; override;
  93. end;
  94. tlabelnodeclass = class of tlabelnode;
  95. traisenode = class(tbinarynode)
  96. frametree : tnode;
  97. constructor create(l,taddr,tframe:tnode);virtual;
  98. function getcopy : tnode;override;
  99. procedure insertintolist(l : tnodelist);override;
  100. function det_resulttype:tnode;override;
  101. function pass_1 : tnode;override;
  102. function docompare(p: tnode): boolean; override;
  103. end;
  104. traisenodeclass = class of traisenode;
  105. ttryexceptnode = class(tloopnode)
  106. constructor create(l,r,_t1 : tnode);virtual;
  107. function det_resulttype:tnode;override;
  108. function pass_1 : tnode;override;
  109. end;
  110. ttryexceptnodeclass = class of ttryexceptnode;
  111. ttryfinallynode = class(tbinarynode)
  112. constructor create(l,r:tnode);virtual;
  113. function det_resulttype:tnode;override;
  114. function pass_1 : tnode;override;
  115. end;
  116. ttryfinallynodeclass = class of ttryfinallynode;
  117. tonnode = class(tbinarynode)
  118. exceptsymtable : tsymtable;
  119. excepttype : tobjectdef;
  120. constructor create(l,r:tnode);virtual;
  121. destructor destroy;override;
  122. function det_resulttype:tnode;override;
  123. function pass_1 : tnode;override;
  124. function getcopy : tnode;override;
  125. function docompare(p: tnode): boolean; override;
  126. end;
  127. tonnodeclass = class of tonnode;
  128. tfailnode = class(tnode)
  129. constructor create;virtual;
  130. function det_resulttype:tnode;override;
  131. function pass_1: tnode;override;
  132. function docompare(p: tnode): boolean; override;
  133. end;
  134. tfailnodeclass = class of tfailnode;
  135. { for compatibilty }
  136. function genloopnode(t : tnodetype;l,r,n1 : tnode;back : boolean) : tnode;
  137. var
  138. cwhilerepeatnode : twhilerepeatnodeclass;
  139. cifnode : tifnodeclass;
  140. cfornode : tfornodeclass;
  141. cexitnode : texitnodeclass;
  142. cbreaknode : tbreaknodeclass;
  143. ccontinuenode : tcontinuenodeclass;
  144. cgotonode : tgotonodeclass;
  145. clabelnode : tlabelnodeclass;
  146. craisenode : traisenodeclass;
  147. ctryexceptnode : ttryexceptnodeclass;
  148. ctryfinallynode : ttryfinallynodeclass;
  149. connode : tonnodeclass;
  150. cfailnode : tfailnodeclass;
  151. implementation
  152. uses
  153. globtype,systems,
  154. cutils,verbose,globals,
  155. symconst,symtable,types,htypechk,pass_1,
  156. ncon,nmem,nld,ncnv,nbas,rgobj,
  157. cgbase
  158. ;
  159. function genloopnode(t : tnodetype;l,r,n1 : tnode;back : boolean) : tnode;
  160. var
  161. p : tnode;
  162. begin
  163. case t of
  164. ifn:
  165. p:=cifnode.create(l,r,n1);
  166. repeatn:
  167. p:=cwhilerepeatnode.create(repeatn,l,r,n1,nil);
  168. whilen:
  169. p:=cwhilerepeatnode.create(whilen,l,r,n1,nil);
  170. forn:
  171. p:=cfornode.create(l,r,n1,nil,back);
  172. end;
  173. genloopnode:=p;
  174. end;
  175. {****************************************************************************
  176. TLOOPNODE
  177. *****************************************************************************}
  178. constructor tloopnode.create(tt : tnodetype;l,r,_t1,_t2 : tnode);
  179. begin
  180. inherited create(tt,l,r);
  181. t1:=_t1;
  182. t2:=_t2;
  183. set_file_line(l);
  184. end;
  185. destructor tloopnode.destroy;
  186. begin
  187. t1.free;
  188. t2.free;
  189. inherited destroy;
  190. end;
  191. function tloopnode.getcopy : tnode;
  192. var
  193. p : tloopnode;
  194. begin
  195. p:=tloopnode(inherited getcopy);
  196. if assigned(t1) then
  197. p.t1:=t1.getcopy
  198. else
  199. p.t1:=nil;
  200. if assigned(t2) then
  201. p.t2:=t2.getcopy
  202. else
  203. p.t2:=nil;
  204. getcopy:=p;
  205. end;
  206. procedure tloopnode.insertintolist(l : tnodelist);
  207. begin
  208. end;
  209. {$ifdef extdebug}
  210. procedure tloopnode.dowrite;
  211. begin
  212. inherited dowrite;
  213. writenodeindention:=writenodeindention+' ';
  214. writenode(t1);
  215. writenode(t2);
  216. delete(writenodeindention,1,4);
  217. end;
  218. {$endif extdebug}
  219. function tloopnode.docompare(p: tnode): boolean;
  220. begin
  221. docompare :=
  222. inherited docompare(p) and
  223. t1.isequal(tloopnode(p).t1) and
  224. t2.isequal(tloopnode(p).t2);
  225. end;
  226. {****************************************************************************
  227. TWHILEREPEATNODE
  228. *****************************************************************************}
  229. function twhilerepeatnode.det_resulttype:tnode;
  230. begin
  231. result:=nil;
  232. resulttype:=voidtype;
  233. resulttypepass(left);
  234. { loop instruction }
  235. if assigned(right) then
  236. resulttypepass(right);
  237. set_varstate(left,true);
  238. if codegenerror then
  239. exit;
  240. if not is_boolean(left.resulttype.def) then
  241. begin
  242. CGMessage(type_e_mismatch);
  243. exit;
  244. end;
  245. end;
  246. function twhilerepeatnode.pass_1 : tnode;
  247. var
  248. old_t_times : longint;
  249. begin
  250. result:=nil;
  251. old_t_times:=rg.t_times;
  252. { calc register weight }
  253. if not(cs_littlesize in aktglobalswitches ) then
  254. rg.t_times:=rg.t_times*8;
  255. rg.cleartempgen;
  256. firstpass(left);
  257. if codegenerror then
  258. exit;
  259. registers32:=left.registers32;
  260. registersfpu:=left.registersfpu;
  261. {$ifdef SUPPORT_MMX}
  262. registersmmx:=left.registersmmx;
  263. {$endif SUPPORT_MMX}
  264. { loop instruction }
  265. if assigned(right) then
  266. begin
  267. rg.cleartempgen;
  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. rg.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:=rg.t_times;
  313. rg.cleartempgen;
  314. firstpass(left);
  315. registers32:=left.registers32;
  316. registersfpu:=left.registersfpu;
  317. {$ifdef SUPPORT_MMX}
  318. registersmmx:=left.registersmmx;
  319. {$endif SUPPORT_MMX}
  320. { determines registers weigths }
  321. if not(cs_littlesize in aktglobalswitches) then
  322. rg.t_times:=rg.t_times div 2;
  323. if rg.t_times=0 then
  324. rg.t_times:=1;
  325. { if path }
  326. if assigned(right) then
  327. begin
  328. rg.cleartempgen;
  329. firstpass(right);
  330. if registers32<right.registers32 then
  331. registers32:=right.registers32;
  332. if registersfpu<right.registersfpu then
  333. registersfpu:=right.registersfpu;
  334. {$ifdef SUPPORT_MMX}
  335. if registersmmx<right.registersmmx then
  336. registersmmx:=right.registersmmx;
  337. {$endif SUPPORT_MMX}
  338. end;
  339. { else path }
  340. if assigned(t1) then
  341. begin
  342. rg.cleartempgen;
  343. firstpass(t1);
  344. if registers32<t1.registers32 then
  345. registers32:=t1.registers32;
  346. if registersfpu<t1.registersfpu then
  347. registersfpu:=t1.registersfpu;
  348. {$ifdef SUPPORT_MMX}
  349. if registersmmx<t1.registersmmx then
  350. registersmmx:=t1.registersmmx;
  351. {$endif SUPPORT_MMX}
  352. end;
  353. { leave if we've got an error in one of the paths }
  354. if codegenerror then
  355. exit;
  356. if left.nodetype=ordconstn then
  357. begin
  358. { optimize }
  359. if tordconstnode(left).value=1 then
  360. begin
  361. hp:=right;
  362. right:=nil;
  363. { we cannot set p to nil !!! }
  364. if assigned(hp) then
  365. result:=hp
  366. else
  367. result:=cnothingnode.create;
  368. end
  369. else
  370. begin
  371. hp:=t1;
  372. t1:=nil;
  373. { we cannot set p to nil !!! }
  374. if assigned(hp) then
  375. result:=hp
  376. else
  377. result:=cnothingnode.create;
  378. end;
  379. end;
  380. rg.t_times:=old_t_times;
  381. end;
  382. {*****************************************************************************
  383. TFORNODE
  384. *****************************************************************************}
  385. constructor tfornode.create(l,r,_t1,_t2 : tnode;back : boolean);
  386. begin
  387. inherited create(forn,l,r,_t1,_t2);
  388. if back then
  389. include(flags,nf_backward);
  390. end;
  391. function tfornode.det_resulttype:tnode;
  392. var
  393. hp : tnode;
  394. begin
  395. result:=nil;
  396. resulttype:=voidtype;
  397. if left.nodetype<>assignn then
  398. begin
  399. CGMessage(cg_e_illegal_expression);
  400. exit;
  401. end;
  402. { save counter var }
  403. t2:=tassignmentnode(left).left.getcopy;
  404. resulttypepass(left);
  405. set_varstate(left,false);
  406. if assigned(t1) then
  407. begin
  408. resulttypepass(t1);
  409. if codegenerror then
  410. exit;
  411. end;
  412. { process count var }
  413. resulttypepass(t2);
  414. set_varstate(t2,true);
  415. if codegenerror then
  416. exit;
  417. { Check count var, record fields are also allowed in tp7 }
  418. hp:=t2;
  419. while (hp.nodetype=subscriptn) or
  420. ((hp.nodetype=vecn) and
  421. is_constintnode(tvecnode(hp).right)) do
  422. hp:=tunarynode(hp).left;
  423. { we need a simple loadn, but the load must be in a global symtable or
  424. in the same lexlevel }
  425. if (hp.nodetype=funcretn) or
  426. ((hp.nodetype=loadn) and
  427. ((tloadnode(hp).symtable.symtablelevel<=1) or
  428. (tloadnode(hp).symtable.symtablelevel=lexlevel))) then
  429. begin
  430. if (hp.nodetype=loadn) and
  431. (tloadnode(hp).symtableentry.typ=varsym) then
  432. tvarsym(tloadnode(hp).symtableentry).varstate:=vs_used;
  433. if (not(is_ordinal(t2.resulttype.def)) or is_64bitint(t2.resulttype.def)) then
  434. CGMessagePos(hp.fileinfo,type_e_ordinal_expr_expected);
  435. end
  436. else
  437. CGMessagePos(hp.fileinfo,cg_e_illegal_count_var);
  438. resulttypepass(right);
  439. set_varstate(right,true);
  440. inserttypeconv(right,t2.resulttype);
  441. end;
  442. function tfornode.pass_1 : tnode;
  443. var
  444. old_t_times : longint;
  445. begin
  446. result:=nil;
  447. { Calc register weight }
  448. old_t_times:=rg.t_times;
  449. if not(cs_littlesize in aktglobalswitches) then
  450. rg.t_times:=rg.t_times*8;
  451. rg.cleartempgen;
  452. firstpass(left);
  453. rg.cleartempgen;
  454. if assigned(t1) then
  455. begin
  456. firstpass(t1);
  457. if codegenerror then
  458. exit;
  459. end;
  460. registers32:=t1.registers32;
  461. registersfpu:=t1.registersfpu;
  462. {$ifdef SUPPORT_MMX}
  463. registersmmx:=left.registersmmx;
  464. {$endif SUPPORT_MMX}
  465. if left.registers32>registers32 then
  466. registers32:=left.registers32;
  467. if left.registersfpu>registersfpu then
  468. registersfpu:=left.registersfpu;
  469. {$ifdef SUPPORT_MMX}
  470. if left.registersmmx>registersmmx then
  471. registersmmx:=left.registersmmx;
  472. {$endif SUPPORT_MMX}
  473. { process count var }
  474. rg.cleartempgen;
  475. firstpass(t2);
  476. if codegenerror then
  477. exit;
  478. if t2.registers32>registers32 then
  479. registers32:=t2.registers32;
  480. if t2.registersfpu>registersfpu then
  481. registersfpu:=t2.registersfpu;
  482. {$ifdef SUPPORT_MMX}
  483. if t2.registersmmx>registersmmx then
  484. registersmmx:=t2.registersmmx;
  485. {$endif SUPPORT_MMX}
  486. rg.cleartempgen;
  487. firstpass(right);
  488. if right.registers32>registers32 then
  489. registers32:=right.registers32;
  490. if right.registersfpu>registersfpu then
  491. registersfpu:=right.registersfpu;
  492. {$ifdef SUPPORT_MMX}
  493. if right.registersmmx>registersmmx then
  494. registersmmx:=right.registersmmx;
  495. {$endif SUPPORT_MMX}
  496. { we need at least one register for comparisons PM }
  497. if registers32=0 then
  498. inc(registers32);
  499. rg.t_times:=old_t_times;
  500. end;
  501. {*****************************************************************************
  502. TEXITNODE
  503. *****************************************************************************}
  504. constructor texitnode.create(l:tnode);
  505. begin
  506. inherited create(exitn,l);
  507. end;
  508. function texitnode.det_resulttype:tnode;
  509. var
  510. pt : tnode;
  511. begin
  512. result:=nil;
  513. { Check the 2 types }
  514. if not inlining_procedure then
  515. begin
  516. if assigned(left) then
  517. begin
  518. inserttypeconv(left,aktprocdef.rettype);
  519. if ret_in_param(aktprocdef.rettype.def) or
  520. (procinfo^.no_fast_exit) or
  521. ((procinfo^.flags and pi_uses_exceptions)<>0) then
  522. begin
  523. pt:=cfuncretnode.create(aktprocdef.funcretsym);
  524. left:=cassignmentnode.create(pt,left);
  525. end;
  526. end;
  527. end;
  528. if assigned(left) then
  529. begin
  530. resulttypepass(left);
  531. set_varstate(left,true);
  532. end;
  533. resulttype:=voidtype;
  534. end;
  535. function texitnode.pass_1 : tnode;
  536. begin
  537. result:=nil;
  538. if assigned(left) then
  539. begin
  540. firstpass(left);
  541. if codegenerror then
  542. exit;
  543. registers32:=left.registers32;
  544. registersfpu:=left.registersfpu;
  545. {$ifdef SUPPORT_MMX}
  546. registersmmx:=left.registersmmx;
  547. {$endif SUPPORT_MMX}
  548. end;
  549. end;
  550. {*****************************************************************************
  551. TBREAKNODE
  552. *****************************************************************************}
  553. constructor tbreaknode.create;
  554. begin
  555. inherited create(breakn);
  556. end;
  557. function tbreaknode.det_resulttype:tnode;
  558. begin
  559. result:=nil;
  560. resulttype:=voidtype;
  561. end;
  562. function tbreaknode.pass_1 : tnode;
  563. begin
  564. result:=nil;
  565. end;
  566. {*****************************************************************************
  567. TCONTINUENODE
  568. *****************************************************************************}
  569. constructor tcontinuenode.create;
  570. begin
  571. inherited create(continuen);
  572. end;
  573. function tcontinuenode.det_resulttype:tnode;
  574. begin
  575. result:=nil;
  576. resulttype:=voidtype;
  577. end;
  578. function tcontinuenode.pass_1 : tnode;
  579. begin
  580. result:=nil;
  581. end;
  582. {*****************************************************************************
  583. TGOTONODE
  584. *****************************************************************************}
  585. constructor tgotonode.create(p : tlabelsym);
  586. begin
  587. inherited create(goton);
  588. exceptionblock:=aktexceptblock;
  589. labsym:=p;
  590. labelnr:=p.lab;
  591. end;
  592. function tgotonode.det_resulttype:tnode;
  593. begin
  594. result:=nil;
  595. resulttype:=voidtype;
  596. end;
  597. function tgotonode.pass_1 : tnode;
  598. begin
  599. result:=nil;
  600. { check if }
  601. if assigned(labsym) and
  602. assigned(labsym.code) and
  603. (exceptionblock<>tlabelnode(labsym.code).exceptionblock) then
  604. begin
  605. writeln('goto exceptblock: ',exceptionblock);
  606. writeln('label exceptblock: ',tlabelnode(labsym.code).exceptionblock);
  607. CGMessage(cg_e_goto_inout_of_exception_block);
  608. end;
  609. end;
  610. function tgotonode.getcopy : tnode;
  611. var
  612. p : tgotonode;
  613. begin
  614. p:=tgotonode(inherited getcopy);
  615. p.labelnr:=labelnr;
  616. p.labsym:=labsym;
  617. p.exceptionblock:=exceptionblock;
  618. result:=p;
  619. end;
  620. function tgotonode.docompare(p: tnode): boolean;
  621. begin
  622. docompare := false;
  623. end;
  624. {*****************************************************************************
  625. TLABELNODE
  626. *****************************************************************************}
  627. constructor tlabelnode.createcase(p : tasmlabel;l:tnode);
  628. begin
  629. inherited create(labeln,l);
  630. { it shouldn't be possible to jump to case labels using goto }
  631. exceptionblock:=-1;
  632. labsym:=nil;
  633. labelnr:=p;
  634. end;
  635. constructor tlabelnode.create(p : tlabelsym;l:tnode);
  636. begin
  637. inherited create(labeln,l);
  638. exceptionblock:=aktexceptblock;
  639. labsym:=p;
  640. labelnr:=p.lab;
  641. { save the current labelnode in the labelsym }
  642. p.code:=self;
  643. end;
  644. function tlabelnode.det_resulttype:tnode;
  645. begin
  646. result:=nil;
  647. { left could still be unassigned }
  648. if assigned(left) then
  649. resulttypepass(left);
  650. resulttype:=voidtype;
  651. end;
  652. function tlabelnode.pass_1 : tnode;
  653. begin
  654. result:=nil;
  655. if assigned(left) then
  656. begin
  657. rg.cleartempgen;
  658. firstpass(left);
  659. registers32:=left.registers32;
  660. registersfpu:=left.registersfpu;
  661. {$ifdef SUPPORT_MMX}
  662. registersmmx:=left.registersmmx;
  663. {$endif SUPPORT_MMX}
  664. end;
  665. end;
  666. function tlabelnode.getcopy : tnode;
  667. var
  668. p : tlabelnode;
  669. begin
  670. p:=tlabelnode(inherited getcopy);
  671. p.labelnr:=labelnr;
  672. p.exceptionblock:=exceptionblock;
  673. p.labsym:=labsym;
  674. result:=p;
  675. end;
  676. function tlabelnode.docompare(p: tnode): boolean;
  677. begin
  678. docompare := false;
  679. end;
  680. {*****************************************************************************
  681. TRAISENODE
  682. *****************************************************************************}
  683. constructor traisenode.create(l,taddr,tframe:tnode);
  684. begin
  685. inherited create(raisen,l,taddr);
  686. frametree:=tframe;
  687. end;
  688. function traisenode.getcopy : tnode;
  689. var
  690. n : traisenode;
  691. begin
  692. n:=traisenode(inherited getcopy);
  693. if assigned(frametree) then
  694. n.frametree:=frametree.getcopy
  695. else
  696. n.frametree:=nil;
  697. getcopy:=n;
  698. end;
  699. procedure traisenode.insertintolist(l : tnodelist);
  700. begin
  701. end;
  702. function traisenode.det_resulttype:tnode;
  703. begin
  704. result:=nil;
  705. resulttype:=voidtype;
  706. if assigned(left) then
  707. begin
  708. { first para must be a _class_ }
  709. resulttypepass(left);
  710. set_varstate(left,true);
  711. if codegenerror then
  712. exit;
  713. if not(is_class(left.resulttype.def)) then
  714. CGMessage(type_e_mismatch);
  715. { insert needed typeconvs for addr,frame }
  716. if assigned(right) then
  717. begin
  718. { addr }
  719. resulttypepass(right);
  720. inserttypeconv(right,s32bittype);
  721. { frame }
  722. if assigned(frametree) then
  723. begin
  724. resulttypepass(frametree);
  725. inserttypeconv(frametree,s32bittype);
  726. end;
  727. end;
  728. end;
  729. end;
  730. function traisenode.pass_1 : tnode;
  731. begin
  732. result:=nil;
  733. if assigned(left) then
  734. begin
  735. { first para must be a _class_ }
  736. firstpass(left);
  737. { insert needed typeconvs for addr,frame }
  738. if assigned(right) then
  739. begin
  740. { addr }
  741. firstpass(right);
  742. { frame }
  743. if assigned(frametree) then
  744. firstpass(frametree);
  745. end;
  746. left_right_max;
  747. end;
  748. end;
  749. function traisenode.docompare(p: tnode): boolean;
  750. begin
  751. docompare := false;
  752. end;
  753. {*****************************************************************************
  754. TTRYEXCEPTNODE
  755. *****************************************************************************}
  756. constructor ttryexceptnode.create(l,r,_t1 : tnode);
  757. begin
  758. inherited create(tryexceptn,l,r,_t1,nil);
  759. end;
  760. function ttryexceptnode.det_resulttype:tnode;
  761. begin
  762. result:=nil;
  763. resulttypepass(left);
  764. { on statements }
  765. if assigned(right) then
  766. resulttypepass(right);
  767. { else block }
  768. if assigned(t1) then
  769. resulttypepass(t1);
  770. resulttype:=voidtype;
  771. end;
  772. function ttryexceptnode.pass_1 : tnode;
  773. begin
  774. result:=nil;
  775. rg.cleartempgen;
  776. firstpass(left);
  777. { on statements }
  778. if assigned(right) then
  779. begin
  780. rg.cleartempgen;
  781. firstpass(right);
  782. registers32:=max(registers32,right.registers32);
  783. registersfpu:=max(registersfpu,right.registersfpu);
  784. {$ifdef SUPPORT_MMX}
  785. registersmmx:=max(registersmmx,right.registersmmx);
  786. {$endif SUPPORT_MMX}
  787. end;
  788. { else block }
  789. if assigned(t1) then
  790. begin
  791. firstpass(t1);
  792. registers32:=max(registers32,t1.registers32);
  793. registersfpu:=max(registersfpu,t1.registersfpu);
  794. {$ifdef SUPPORT_MMX}
  795. registersmmx:=max(registersmmx,t1.registersmmx);
  796. {$endif SUPPORT_MMX}
  797. end;
  798. end;
  799. {*****************************************************************************
  800. TTRYFINALLYNODE
  801. *****************************************************************************}
  802. constructor ttryfinallynode.create(l,r:tnode);
  803. begin
  804. inherited create(tryfinallyn,l,r);
  805. end;
  806. function ttryfinallynode.det_resulttype:tnode;
  807. begin
  808. result:=nil;
  809. resulttype:=voidtype;
  810. resulttypepass(left);
  811. set_varstate(left,true);
  812. resulttypepass(right);
  813. set_varstate(right,true);
  814. end;
  815. function ttryfinallynode.pass_1 : tnode;
  816. begin
  817. result:=nil;
  818. rg.cleartempgen;
  819. firstpass(left);
  820. rg.cleartempgen;
  821. firstpass(right);
  822. left_right_max;
  823. end;
  824. {*****************************************************************************
  825. TONNODE
  826. *****************************************************************************}
  827. constructor tonnode.create(l,r:tnode);
  828. begin
  829. inherited create(onn,l,r);
  830. exceptsymtable:=nil;
  831. excepttype:=nil;
  832. end;
  833. destructor tonnode.destroy;
  834. begin
  835. if assigned(exceptsymtable) then
  836. exceptsymtable.free;
  837. inherited destroy;
  838. end;
  839. function tonnode.getcopy : tnode;
  840. var
  841. n : tonnode;
  842. begin
  843. n:=tonnode(inherited getcopy);
  844. n.exceptsymtable:=exceptsymtable;
  845. n.excepttype:=excepttype;
  846. result:=n;
  847. end;
  848. function tonnode.det_resulttype:tnode;
  849. begin
  850. result:=nil;
  851. resulttype:=voidtype;
  852. if not(is_class(excepttype)) then
  853. CGMessage(type_e_mismatch);
  854. if assigned(left) then
  855. resulttypepass(left);
  856. if assigned(right) then
  857. resulttypepass(right);
  858. end;
  859. function tonnode.pass_1 : tnode;
  860. begin
  861. result:=nil;
  862. rg.cleartempgen;
  863. registers32:=0;
  864. registersfpu:=0;
  865. {$ifdef SUPPORT_MMX}
  866. registersmmx:=0;
  867. {$endif SUPPORT_MMX}
  868. if assigned(left) then
  869. begin
  870. firstpass(left);
  871. registers32:=left.registers32;
  872. registersfpu:=left.registersfpu;
  873. {$ifdef SUPPORT_MMX}
  874. registersmmx:=left.registersmmx;
  875. {$endif SUPPORT_MMX}
  876. end;
  877. rg.cleartempgen;
  878. if assigned(right) then
  879. begin
  880. firstpass(right);
  881. registers32:=max(registers32,right.registers32);
  882. registersfpu:=max(registersfpu,right.registersfpu);
  883. {$ifdef SUPPORT_MMX}
  884. registersmmx:=max(registersmmx,right.registersmmx);
  885. {$endif SUPPORT_MMX}
  886. end;
  887. end;
  888. function tonnode.docompare(p: tnode): boolean;
  889. begin
  890. docompare := false;
  891. end;
  892. {*****************************************************************************
  893. TFAILNODE
  894. *****************************************************************************}
  895. constructor tfailnode.create;
  896. begin
  897. inherited create(failn);
  898. end;
  899. function tfailnode.det_resulttype:tnode;
  900. begin
  901. result:=nil;
  902. resulttype:=voidtype;
  903. end;
  904. function tfailnode.pass_1 : tnode;
  905. begin
  906. result:=nil;
  907. end;
  908. function tfailnode.docompare(p: tnode): boolean;
  909. begin
  910. docompare := false;
  911. end;
  912. begin
  913. cwhilerepeatnode:=twhilerepeatnode;
  914. cifnode:=tifnode;
  915. cfornode:=tfornode;
  916. cexitnode:=texitnode;
  917. cgotonode:=tgotonode;
  918. clabelnode:=tlabelnode;
  919. craisenode:=traisenode;
  920. ctryexceptnode:=ttryexceptnode;
  921. ctryfinallynode:=ttryfinallynode;
  922. connode:=tonnode;
  923. cfailnode:=tfailnode;
  924. end.
  925. {
  926. $Log$
  927. Revision 1.33 2002-07-01 18:46:23 peter
  928. * internal linker
  929. * reorganized aasm layer
  930. Revision 1.32 2002/05/18 13:34:10 peter
  931. * readded missing revisions
  932. Revision 1.31 2002/05/16 19:46:38 carl
  933. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  934. + try to fix temp allocation (still in ifdef)
  935. + generic constructor calls
  936. + start of tassembler / tmodulebase class cleanup
  937. Revision 1.29 2002/05/12 16:53:07 peter
  938. * moved entry and exitcode to ncgutil and cgobj
  939. * foreach gets extra argument for passing local data to the
  940. iterator function
  941. * -CR checks also class typecasts at runtime by changing them
  942. into as
  943. * fixed compiler to cycle with the -CR option
  944. * fixed stabs with elf writer, finally the global variables can
  945. be watched
  946. * removed a lot of routines from cga unit and replaced them by
  947. calls to cgobj
  948. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  949. u32bit then the other is typecasted also to u32bit without giving
  950. a rangecheck warning/error.
  951. * fixed pascal calling method with reversing also the high tree in
  952. the parast, detected by tcalcst3 test
  953. Revision 1.28 2002/03/31 20:26:34 jonas
  954. + a_loadfpu_* and a_loadmm_* methods in tcg
  955. * register allocation is now handled by a class and is mostly processor
  956. independent (+rgobj.pas and i386/rgcpu.pas)
  957. * temp allocation is now handled by a class (+tgobj.pas, -i386\tgcpu.pas)
  958. * some small improvements and fixes to the optimizer
  959. * some register allocation fixes
  960. * some fpuvaroffset fixes in the unary minus node
  961. * push/popusedregisters is now called rg.save/restoreusedregisters and
  962. (for i386) uses temps instead of push/pop's when using -Op3 (that code is
  963. also better optimizable)
  964. * fixed and optimized register saving/restoring for new/dispose nodes
  965. * LOC_FPU locations now also require their "register" field to be set to
  966. R_ST, not R_ST0 (the latter is used for LOC_CFPUREGISTER locations only)
  967. - list field removed of the tnode class because it's not used currently
  968. and can cause hard-to-find bugs
  969. }