nflw.pas 53 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754
  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,cpubase,
  24. aasmbase,aasmtai,aasmcpu,symnot,
  25. symtype,symbase,symdef,symsym;
  26. type
  27. { flags used by loop nodes }
  28. tloopflag = (
  29. { set if it is a for ... downto ... do loop }
  30. lnf_backward,
  31. { Do we need to parse childs to set var state? }
  32. lnf_varstate,
  33. { Do a test at the begin of the loop?}
  34. lnf_testatbegin,
  35. { Negate the loop test? }
  36. lnf_checknegate,
  37. { Should the value of the loop variable on exit be correct. }
  38. lnf_dont_mind_loopvar_on_exit);
  39. tloopflags = set of tloopflag;
  40. const
  41. { loop flags which must match to consider loop nodes equal regarding the flags }
  42. loopflagsequal = [lnf_backward];
  43. type
  44. tloopnode = class(tbinarynode)
  45. t1,t2 : tnode;
  46. loopflags : tloopflags;
  47. constructor create(tt : tnodetype;l,r,_t1,_t2 : tnode);virtual;
  48. destructor destroy;override;
  49. function getcopy : tnode;override;
  50. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  51. procedure ppuwrite(ppufile:tcompilerppufile);override;
  52. procedure buildderefimpl;override;
  53. procedure derefimpl;override;
  54. procedure insertintolist(l : tnodelist);override;
  55. procedure printnodetree(var t:text);override;
  56. function docompare(p: tnode): boolean; override;
  57. end;
  58. twhilerepeatnode = class(tloopnode)
  59. constructor create(l,r,_t1:Tnode;tab,cn:boolean);virtual;
  60. function det_resulttype:tnode;override;
  61. function pass_1 : tnode;override;
  62. {$ifdef state_tracking}
  63. function track_state_pass(exec_known:boolean):boolean;override;
  64. {$endif}
  65. end;
  66. twhilerepeatnodeclass = class of twhilerepeatnode;
  67. tifnode = class(tloopnode)
  68. constructor create(l,r,_t1 : tnode);virtual;
  69. function det_resulttype:tnode;override;
  70. function pass_1 : tnode;override;
  71. end;
  72. tifnodeclass = class of tifnode;
  73. tfornode = class(tloopnode)
  74. loopvar_notid:cardinal;
  75. constructor create(l,r,_t1,_t2 : tnode;back : boolean);virtual;
  76. procedure loop_var_access(not_type:Tnotification_flag;symbol:Tsym);
  77. function det_resulttype:tnode;override;
  78. function pass_1 : tnode;override;
  79. end;
  80. tfornodeclass = class of tfornode;
  81. texitnode = class(tunarynode)
  82. constructor create(l:tnode);virtual;
  83. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  84. procedure ppuwrite(ppufile:tcompilerppufile);override;
  85. function det_resulttype:tnode;override;
  86. function pass_1 : tnode;override;
  87. end;
  88. texitnodeclass = class of texitnode;
  89. tbreaknode = class(tnode)
  90. constructor create;virtual;
  91. function det_resulttype:tnode;override;
  92. function pass_1 : tnode;override;
  93. end;
  94. tbreaknodeclass = class of tbreaknode;
  95. tcontinuenode = class(tnode)
  96. constructor create;virtual;
  97. function det_resulttype:tnode;override;
  98. function pass_1 : tnode;override;
  99. end;
  100. tcontinuenodeclass = class of tcontinuenode;
  101. tgotonode = class(tnode)
  102. labsym : tlabelsym;
  103. labsymderef : tderef;
  104. exceptionblock : integer;
  105. { internlab : tinterngotolabel;}
  106. constructor create(p : tlabelsym);virtual;
  107. { constructor createintern(g:tinterngotolabel);}
  108. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  109. procedure ppuwrite(ppufile:tcompilerppufile);override;
  110. procedure buildderefimpl;override;
  111. procedure derefimpl;override;
  112. function getcopy : tnode;override;
  113. function det_resulttype:tnode;override;
  114. function pass_1 : tnode;override;
  115. function docompare(p: tnode): boolean; override;
  116. end;
  117. tgotonodeclass = class of tgotonode;
  118. tlabelnode = class(tunarynode)
  119. labelnr : tasmlabel;
  120. labsym : tlabelsym;
  121. labsymderef : tderef;
  122. exceptionblock : integer;
  123. constructor createcase(p : tasmlabel;l:tnode);virtual;
  124. constructor create(p : tlabelsym;l:tnode);virtual;
  125. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  126. procedure ppuwrite(ppufile:tcompilerppufile);override;
  127. procedure buildderefimpl;override;
  128. procedure derefimpl;override;
  129. function getcopy : tnode;override;
  130. function det_resulttype:tnode;override;
  131. function pass_1 : tnode;override;
  132. function docompare(p: tnode): boolean; override;
  133. end;
  134. tlabelnodeclass = class of tlabelnode;
  135. traisenode = class(tbinarynode)
  136. frametree : tnode;
  137. constructor create(l,taddr,tframe:tnode);virtual;
  138. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  139. procedure ppuwrite(ppufile:tcompilerppufile);override;
  140. procedure buildderefimpl;override;
  141. procedure derefimpl;override;
  142. function getcopy : tnode;override;
  143. procedure insertintolist(l : tnodelist);override;
  144. function det_resulttype:tnode;override;
  145. function pass_1 : tnode;override;
  146. function docompare(p: tnode): boolean; override;
  147. end;
  148. traisenodeclass = class of traisenode;
  149. ttryexceptnode = class(tloopnode)
  150. constructor create(l,r,_t1 : tnode);virtual;
  151. function det_resulttype:tnode;override;
  152. function pass_1 : tnode;override;
  153. end;
  154. ttryexceptnodeclass = class of ttryexceptnode;
  155. ttryfinallynode = class(tloopnode)
  156. implicitframe : boolean;
  157. constructor create(l,r:tnode);virtual;
  158. constructor create_implicit(l,r,_t1:tnode);virtual;
  159. function det_resulttype:tnode;override;
  160. function pass_1 : tnode;override;
  161. end;
  162. ttryfinallynodeclass = class of ttryfinallynode;
  163. tonnode = class(tbinarynode)
  164. exceptsymtable : tsymtable;
  165. excepttype : tobjectdef;
  166. constructor create(l,r:tnode);virtual;
  167. destructor destroy;override;
  168. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  169. function det_resulttype:tnode;override;
  170. function pass_1 : tnode;override;
  171. function getcopy : tnode;override;
  172. function docompare(p: tnode): boolean; override;
  173. end;
  174. tonnodeclass = class of tonnode;
  175. { for compatibilty }
  176. function genloopnode(t : tnodetype;l,r,n1 : tnode;back : boolean) : tnode;
  177. var
  178. cwhilerepeatnode : twhilerepeatnodeclass;
  179. cifnode : tifnodeclass;
  180. cfornode : tfornodeclass;
  181. cexitnode : texitnodeclass;
  182. cbreaknode : tbreaknodeclass;
  183. ccontinuenode : tcontinuenodeclass;
  184. cgotonode : tgotonodeclass;
  185. clabelnode : tlabelnodeclass;
  186. craisenode : traisenodeclass;
  187. ctryexceptnode : ttryexceptnodeclass;
  188. ctryfinallynode : ttryfinallynodeclass;
  189. connode : tonnodeclass;
  190. implementation
  191. uses
  192. globtype,systems,
  193. cutils,verbose,globals,
  194. symconst,paramgr,defcmp,defutil,htypechk,pass_1,
  195. ncal,nadd,ncon,nmem,nld,ncnv,nbas,cgobj,
  196. {$ifdef state_tracking}
  197. nstate,
  198. {$endif}
  199. cgbase,procinfo
  200. ;
  201. function genloopnode(t : tnodetype;l,r,n1 : tnode;back : boolean) : tnode;
  202. var
  203. p : tnode;
  204. begin
  205. case t of
  206. ifn:
  207. p:=cifnode.create(l,r,n1);
  208. whilerepeatn:
  209. if back then
  210. {Repeat until.}
  211. p:=cwhilerepeatnode.create(l,r,n1,false,true)
  212. else
  213. {While do.}
  214. p:=cwhilerepeatnode.create(l,r,n1,true,false);
  215. forn:
  216. p:=cfornode.create(l,r,n1,nil,back);
  217. end;
  218. resulttypepass(p);
  219. genloopnode:=p;
  220. end;
  221. {****************************************************************************
  222. TLOOPNODE
  223. *****************************************************************************}
  224. constructor tloopnode.create(tt : tnodetype;l,r,_t1,_t2 : tnode);
  225. begin
  226. inherited create(tt,l,r);
  227. t1:=_t1;
  228. t2:=_t2;
  229. set_file_line(l);
  230. end;
  231. destructor tloopnode.destroy;
  232. begin
  233. t1.free;
  234. t2.free;
  235. inherited destroy;
  236. end;
  237. constructor tloopnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  238. begin
  239. inherited ppuload(t,ppufile);
  240. t1:=ppuloadnode(ppufile);
  241. t2:=ppuloadnode(ppufile);
  242. end;
  243. procedure tloopnode.ppuwrite(ppufile:tcompilerppufile);
  244. begin
  245. inherited ppuwrite(ppufile);
  246. ppuwritenode(ppufile,t1);
  247. ppuwritenode(ppufile,t2);
  248. end;
  249. procedure tloopnode.buildderefimpl;
  250. begin
  251. inherited buildderefimpl;
  252. if assigned(t1) then
  253. t1.buildderefimpl;
  254. if assigned(t2) then
  255. t2.buildderefimpl;
  256. end;
  257. procedure tloopnode.derefimpl;
  258. begin
  259. inherited derefimpl;
  260. if assigned(t1) then
  261. t1.derefimpl;
  262. if assigned(t2) then
  263. t2.derefimpl;
  264. end;
  265. function tloopnode.getcopy : tnode;
  266. var
  267. p : tloopnode;
  268. begin
  269. p:=tloopnode(inherited getcopy);
  270. if assigned(t1) then
  271. p.t1:=t1.getcopy
  272. else
  273. p.t1:=nil;
  274. if assigned(t2) then
  275. p.t2:=t2.getcopy
  276. else
  277. p.t2:=nil;
  278. p.loopflags:=loopflags;
  279. getcopy:=p;
  280. end;
  281. procedure tloopnode.insertintolist(l : tnodelist);
  282. begin
  283. end;
  284. procedure tloopnode.printnodetree(var t:text);
  285. begin
  286. write(t,printnodeindention,'(');
  287. printnodeindent;
  288. printnodeinfo(t);
  289. printnode(t,left);
  290. printnode(t,right);
  291. printnode(t,t1);
  292. printnode(t,t2);
  293. printnodeunindent;
  294. writeln(t,printnodeindention,')');
  295. end;
  296. function tloopnode.docompare(p: tnode): boolean;
  297. begin
  298. docompare :=
  299. inherited docompare(p) and
  300. (loopflags*loopflagsequal=tloopnode(p).loopflags*loopflagsequal) and
  301. t1.isequal(tloopnode(p).t1) and
  302. t2.isequal(tloopnode(p).t2);
  303. end;
  304. {****************************************************************************
  305. TWHILEREPEATNODE
  306. *****************************************************************************}
  307. constructor Twhilerepeatnode.create(l,r,_t1:Tnode;tab,cn:boolean);
  308. begin
  309. inherited create(whilerepeatn,l,r,_t1,nil);
  310. if tab then
  311. include(loopflags, lnf_testatbegin);
  312. if cn then
  313. include(loopflags,lnf_checknegate);
  314. end;
  315. function twhilerepeatnode.det_resulttype:tnode;
  316. var
  317. t:Tunarynode;
  318. begin
  319. result:=nil;
  320. resulttype:=voidtype;
  321. resulttypepass(left);
  322. {A not node can be removed.}
  323. if left.nodetype=notn then
  324. begin
  325. t:=Tunarynode(left);
  326. left:=Tunarynode(left).left;
  327. t.left:=nil;
  328. t.destroy;
  329. {$ifdef Delphi}
  330. { How can this be handled in Delphi ? }
  331. RunError(255);
  332. {$else}
  333. {Symdif operator, in case you are wondering:}
  334. loopflags:=loopflags >< [lnf_checknegate];
  335. {$endif}
  336. end;
  337. { loop instruction }
  338. if assigned(right) then
  339. resulttypepass(right);
  340. set_varstate(left,vs_used,true);
  341. if codegenerror then
  342. exit;
  343. if not is_boolean(left.resulttype.def) then
  344. begin
  345. CGMessage1(type_e_boolean_expr_expected,left.resulttype.def.typename);
  346. exit;
  347. end;
  348. end;
  349. function twhilerepeatnode.pass_1 : tnode;
  350. var
  351. old_t_times : longint;
  352. begin
  353. result:=nil;
  354. expectloc:=LOC_VOID;
  355. old_t_times:=cg.t_times;
  356. { calc register weight }
  357. if not(cs_littlesize in aktglobalswitches ) then
  358. cg.t_times:=cg.t_times*8;
  359. firstpass(left);
  360. if codegenerror then
  361. exit;
  362. registersint:=left.registersint;
  363. registersfpu:=left.registersfpu;
  364. {$ifdef SUPPORT_MMX}
  365. registersmmx:=left.registersmmx;
  366. {$endif SUPPORT_MMX}
  367. { loop instruction }
  368. if assigned(right) then
  369. begin
  370. firstpass(right);
  371. if codegenerror then
  372. exit;
  373. if registersint<right.registersint then
  374. registersint:=right.registersint;
  375. if registersfpu<right.registersfpu then
  376. registersfpu:=right.registersfpu;
  377. {$ifdef SUPPORT_MMX}
  378. if registersmmx<right.registersmmx then
  379. registersmmx:=right.registersmmx;
  380. {$endif SUPPORT_MMX}
  381. end;
  382. cg.t_times:=old_t_times;
  383. end;
  384. {$ifdef state_tracking}
  385. function Twhilerepeatnode.track_state_pass(exec_known:boolean):boolean;
  386. var condition:Tnode;
  387. code:Tnode;
  388. done:boolean;
  389. value:boolean;
  390. change:boolean;
  391. firsttest:boolean;
  392. factval:Tnode;
  393. begin
  394. track_state_pass:=false;
  395. done:=false;
  396. firsttest:=true;
  397. {For repeat until statements, first do a pass through the code.}
  398. if not(lnf_testatbegin in flags) then
  399. begin
  400. code:=right.getcopy;
  401. if code.track_state_pass(exec_known) then
  402. track_state_pass:=true;
  403. code.destroy;
  404. end;
  405. repeat
  406. condition:=left.getcopy;
  407. code:=right.getcopy;
  408. change:=condition.track_state_pass(exec_known);
  409. factval:=aktstate.find_fact(left);
  410. if factval<>nil then
  411. begin
  412. condition.destroy;
  413. condition:=factval.getcopy;
  414. change:=true;
  415. end;
  416. if change then
  417. begin
  418. track_state_pass:=true;
  419. {Force new resulttype pass.}
  420. condition.resulttype.def:=nil;
  421. do_resulttypepass(condition);
  422. end;
  423. if is_constboolnode(condition) then
  424. begin
  425. {Try to turn a while loop into a repeat loop.}
  426. if firsttest then
  427. exclude(flags,testatbegin);
  428. value:=(Tordconstnode(condition).value<>0) xor checknegate;
  429. if value then
  430. begin
  431. if code.track_state_pass(exec_known) then
  432. track_state_pass:=true;
  433. end
  434. else
  435. done:=true;
  436. end
  437. else
  438. begin
  439. {Remove any modified variables from the state.}
  440. code.track_state_pass(false);
  441. done:=true;
  442. end;
  443. code.destroy;
  444. condition.destroy;
  445. firsttest:=false;
  446. until done;
  447. {The loop condition is also known, for example:
  448. while i<10 do
  449. begin
  450. ...
  451. end;
  452. When the loop is done, we do know that i<10 = false.
  453. }
  454. condition:=left.getcopy;
  455. if condition.track_state_pass(exec_known) then
  456. begin
  457. track_state_pass:=true;
  458. {Force new resulttype pass.}
  459. condition.resulttype.def:=nil;
  460. do_resulttypepass(condition);
  461. end;
  462. if not is_constboolnode(condition) then
  463. aktstate.store_fact(condition,
  464. cordconstnode.create(byte(checknegate),booltype,true))
  465. else
  466. condition.destroy;
  467. end;
  468. {$endif}
  469. {*****************************************************************************
  470. TIFNODE
  471. *****************************************************************************}
  472. constructor tifnode.create(l,r,_t1 : tnode);
  473. begin
  474. inherited create(ifn,l,r,_t1,nil);
  475. end;
  476. function tifnode.det_resulttype:tnode;
  477. begin
  478. result:=nil;
  479. resulttype:=voidtype;
  480. resulttypepass(left);
  481. { if path }
  482. if assigned(right) then
  483. resulttypepass(right);
  484. { else path }
  485. if assigned(t1) then
  486. resulttypepass(t1);
  487. set_varstate(left,vs_used,true);
  488. if codegenerror then
  489. exit;
  490. if not is_boolean(left.resulttype.def) then
  491. Message1(type_e_boolean_expr_expected,left.resulttype.def.typename);
  492. end;
  493. function tifnode.pass_1 : tnode;
  494. var
  495. old_t_times : longint;
  496. hp : tnode;
  497. begin
  498. result:=nil;
  499. expectloc:=LOC_VOID;
  500. old_t_times:=cg.t_times;
  501. firstpass(left);
  502. registersint:=left.registersint;
  503. registersfpu:=left.registersfpu;
  504. {$ifdef SUPPORT_MMX}
  505. registersmmx:=left.registersmmx;
  506. {$endif SUPPORT_MMX}
  507. { determines registers weigths }
  508. if not(cs_littlesize in aktglobalswitches) then
  509. cg.t_times:=cg.t_times div 2;
  510. if cg.t_times=0 then
  511. cg.t_times:=1;
  512. { if path }
  513. if assigned(right) then
  514. begin
  515. firstpass(right);
  516. if registersint<right.registersint then
  517. registersint:=right.registersint;
  518. if registersfpu<right.registersfpu then
  519. registersfpu:=right.registersfpu;
  520. {$ifdef SUPPORT_MMX}
  521. if registersmmx<right.registersmmx then
  522. registersmmx:=right.registersmmx;
  523. {$endif SUPPORT_MMX}
  524. end;
  525. { else path }
  526. if assigned(t1) then
  527. begin
  528. firstpass(t1);
  529. if registersint<t1.registersint then
  530. registersint:=t1.registersint;
  531. if registersfpu<t1.registersfpu then
  532. registersfpu:=t1.registersfpu;
  533. {$ifdef SUPPORT_MMX}
  534. if registersmmx<t1.registersmmx then
  535. registersmmx:=t1.registersmmx;
  536. {$endif SUPPORT_MMX}
  537. end;
  538. { leave if we've got an error in one of the paths }
  539. if codegenerror then
  540. exit;
  541. if left.nodetype=ordconstn then
  542. begin
  543. { optimize }
  544. if tordconstnode(left).value=1 then
  545. begin
  546. hp:=right;
  547. right:=nil;
  548. { we cannot set p to nil !!! }
  549. if assigned(hp) then
  550. result:=hp
  551. else
  552. result:=cnothingnode.create;
  553. end
  554. else
  555. begin
  556. hp:=t1;
  557. t1:=nil;
  558. { we cannot set p to nil !!! }
  559. if assigned(hp) then
  560. result:=hp
  561. else
  562. result:=cnothingnode.create;
  563. end;
  564. end;
  565. cg.t_times:=old_t_times;
  566. end;
  567. {*****************************************************************************
  568. TFORNODE
  569. *****************************************************************************}
  570. constructor tfornode.create(l,r,_t1,_t2 : tnode;back : boolean);
  571. begin
  572. inherited create(forn,l,r,_t1,_t2);
  573. if back then
  574. include(loopflags,lnf_backward);
  575. include(loopflags,lnf_testatbegin);
  576. end;
  577. procedure Tfornode.loop_var_access(not_type:Tnotification_flag;
  578. symbol:Tsym);
  579. begin
  580. {If there is a read access, the value of the loop counter is important;
  581. at the end of the loop the loop variable should contain the value it
  582. had in the last iteration.}
  583. if not_type=vn_onwrite then
  584. begin
  585. writeln('Loopvar does not matter on exit');
  586. end
  587. else
  588. begin
  589. exclude(loopflags,lnf_dont_mind_loopvar_on_exit);
  590. writeln('Loopvar does matter on exit');
  591. end;
  592. Tvarsym(symbol).unregister_notification(loopvar_notid);
  593. end;
  594. function tfornode.det_resulttype:tnode;
  595. var
  596. hp : tnode;
  597. begin
  598. result:=nil;
  599. resulttype:=voidtype;
  600. if left.nodetype<>assignn then
  601. begin
  602. CGMessage(cg_e_illegal_expression);
  603. exit;
  604. end;
  605. {Can we spare the first comparision?}
  606. if (right.nodetype=ordconstn) and (Tassignmentnode(left).right.nodetype=ordconstn) then
  607. if (
  608. (lnf_backward in loopflags) and
  609. (Tordconstnode(Tassignmentnode(left).right).value>=Tordconstnode(right).value)
  610. )
  611. or not(
  612. (lnf_backward in loopflags) and
  613. (Tordconstnode(Tassignmentnode(left).right).value<=Tordconstnode(right).value)
  614. ) then
  615. exclude(loopflags,lnf_testatbegin);
  616. { save counter var }
  617. t2:=tassignmentnode(left).left.getcopy;
  618. resulttypepass(left);
  619. set_varstate(left,vs_used,true);
  620. if assigned(t1) then
  621. begin
  622. resulttypepass(t1);
  623. if codegenerror then
  624. exit;
  625. end;
  626. { process count var }
  627. resulttypepass(t2);
  628. set_varstate(t2,vs_used,false);
  629. if codegenerror then
  630. exit;
  631. { Check count var, record fields are also allowed in tp7 }
  632. hp:=t2;
  633. while (hp.nodetype=subscriptn) or
  634. ((hp.nodetype=vecn) and
  635. is_constintnode(tvecnode(hp).right)) or
  636. ((hp.nodetype=typeconvn) and
  637. (ttypeconvnode(hp).convtype=tc_equal)) do
  638. hp:=tunarynode(hp).left;
  639. { we need a simple loadn, but the load must be in a global symtable or
  640. in the same level as the para of the current proc }
  641. if (
  642. (hp.nodetype=loadn) and
  643. (
  644. (tloadnode(hp).symtable.symtablelevel=main_program_level) or
  645. (tloadnode(hp).symtable.symtablelevel=current_procinfo.procdef.parast.symtablelevel)
  646. ) and
  647. not(
  648. (tloadnode(hp).symtableentry.typ=varsym) and
  649. ((tvarsym(tloadnode(hp).symtableentry).varspez in [vs_var,vs_out]) or
  650. (vo_is_thread_var in tvarsym(tloadnode(hp).symtableentry).varoptions))
  651. )
  652. ) then
  653. begin
  654. if (hp.nodetype=loadn) and
  655. (tloadnode(hp).symtableentry.typ=varsym) then
  656. tvarsym(tloadnode(hp).symtableentry).varstate:=vs_used;
  657. if not(is_ordinal(t2.resulttype.def))
  658. {$ifndef cpu64bit}
  659. or is_64bitint(t2.resulttype.def)
  660. {$endif cpu64bit}
  661. then
  662. CGMessagePos(hp.fileinfo,type_e_ordinal_expr_expected);
  663. end
  664. else
  665. CGMessagePos(hp.fileinfo,cg_e_illegal_count_var);
  666. resulttypepass(right);
  667. set_varstate(right,vs_used,true);
  668. inserttypeconv(right,t2.resulttype);
  669. end;
  670. function tfornode.pass_1 : tnode;
  671. var
  672. old_t_times : longint;
  673. {$ifdef loopvar_dont_mind}
  674. hp : Tnode;
  675. {$endif loopvar_dont_mind}
  676. begin
  677. result:=nil;
  678. expectloc:=LOC_VOID;
  679. { Calc register weight }
  680. old_t_times:=cg.t_times;
  681. if not(cs_littlesize in aktglobalswitches) then
  682. cg.t_times:=cg.t_times*8;
  683. firstpass(left);
  684. if assigned(t1) then
  685. begin
  686. firstpass(t1);
  687. if codegenerror then
  688. exit;
  689. end;
  690. registersint:=t1.registersint;
  691. registersfpu:=t1.registersfpu;
  692. {$ifdef SUPPORT_MMX}
  693. registersmmx:=left.registersmmx;
  694. {$endif SUPPORT_MMX}
  695. if left.registersint>registersint then
  696. registersint:=left.registersint;
  697. if left.registersfpu>registersfpu then
  698. registersfpu:=left.registersfpu;
  699. {$ifdef SUPPORT_MMX}
  700. if left.registersmmx>registersmmx then
  701. registersmmx:=left.registersmmx;
  702. {$endif SUPPORT_MMX}
  703. { process count var }
  704. firstpass(t2);
  705. if codegenerror then
  706. exit;
  707. if t2.registersint>registersint then
  708. registersint:=t2.registersint;
  709. if t2.registersfpu>registersfpu then
  710. registersfpu:=t2.registersfpu;
  711. {$ifdef SUPPORT_MMX}
  712. if t2.registersmmx>registersmmx then
  713. registersmmx:=t2.registersmmx;
  714. {$endif SUPPORT_MMX}
  715. firstpass(right);
  716. {$ifdef loopvar_dont_mind}
  717. { Check count var, record fields are also allowed in tp7 }
  718. include(loopflags,lnf_dont_mind_loopvar_on_exit);
  719. hp:=t2;
  720. while (hp.nodetype=subscriptn) or
  721. ((hp.nodetype=vecn) and
  722. is_constintnode(tvecnode(hp).right)) do
  723. hp:=tunarynode(hp).left;
  724. if (hp.nodetype=loadn) and (Tloadnode(hp).symtableentry.typ=varsym) then
  725. loopvar_notid:=Tvarsym(Tloadnode(hp).symtableentry).
  726. register_notification([vn_onread,vn_onwrite],@loop_var_access);
  727. {$endif}
  728. if right.registersint>registersint then
  729. registersint:=right.registersint;
  730. if right.registersfpu>registersfpu then
  731. registersfpu:=right.registersfpu;
  732. {$ifdef SUPPORT_MMX}
  733. if right.registersmmx>registersmmx then
  734. registersmmx:=right.registersmmx;
  735. {$endif SUPPORT_MMX}
  736. { we need at least one register for comparisons PM }
  737. if registersint=0 then
  738. inc(registersint);
  739. cg.t_times:=old_t_times;
  740. end;
  741. {*****************************************************************************
  742. TEXITNODE
  743. *****************************************************************************}
  744. constructor texitnode.create(l:tnode);
  745. begin
  746. inherited create(exitn,l);
  747. end;
  748. constructor texitnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  749. begin
  750. inherited ppuload(t,ppufile);
  751. end;
  752. procedure texitnode.ppuwrite(ppufile:tcompilerppufile);
  753. begin
  754. inherited ppuwrite(ppufile);
  755. end;
  756. function texitnode.det_resulttype:tnode;
  757. begin
  758. result:=nil;
  759. if assigned(left) then
  760. begin
  761. { add assignment to funcretsym }
  762. inserttypeconv(left,current_procinfo.procdef.rettype);
  763. left:=cassignmentnode.create(
  764. cloadnode.create(current_procinfo.procdef.funcretsym,current_procinfo.procdef.funcretsym.owner),
  765. left);
  766. resulttypepass(left);
  767. set_varstate(left,vs_used,true);
  768. end;
  769. resulttype:=voidtype;
  770. end;
  771. function texitnode.pass_1 : tnode;
  772. begin
  773. result:=nil;
  774. expectloc:=LOC_VOID;
  775. if assigned(left) then
  776. begin
  777. firstpass(left);
  778. if codegenerror then
  779. exit;
  780. registersint:=left.registersint;
  781. registersfpu:=left.registersfpu;
  782. {$ifdef SUPPORT_MMX}
  783. registersmmx:=left.registersmmx;
  784. {$endif SUPPORT_MMX}
  785. end;
  786. end;
  787. {*****************************************************************************
  788. TBREAKNODE
  789. *****************************************************************************}
  790. constructor tbreaknode.create;
  791. begin
  792. inherited create(breakn);
  793. end;
  794. function tbreaknode.det_resulttype:tnode;
  795. begin
  796. result:=nil;
  797. resulttype:=voidtype;
  798. end;
  799. function tbreaknode.pass_1 : tnode;
  800. begin
  801. result:=nil;
  802. expectloc:=LOC_VOID;
  803. end;
  804. {*****************************************************************************
  805. TCONTINUENODE
  806. *****************************************************************************}
  807. constructor tcontinuenode.create;
  808. begin
  809. inherited create(continuen);
  810. end;
  811. function tcontinuenode.det_resulttype:tnode;
  812. begin
  813. result:=nil;
  814. resulttype:=voidtype;
  815. end;
  816. function tcontinuenode.pass_1 : tnode;
  817. begin
  818. result:=nil;
  819. expectloc:=LOC_VOID;
  820. end;
  821. {*****************************************************************************
  822. TGOTONODE
  823. *****************************************************************************}
  824. constructor tgotonode.create(p : tlabelsym);
  825. begin
  826. inherited create(goton);
  827. exceptionblock:=aktexceptblock;
  828. labsym:=p;
  829. end;
  830. constructor tgotonode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  831. begin
  832. inherited ppuload(t,ppufile);
  833. ppufile.getderef(labsymderef);
  834. exceptionblock:=ppufile.getbyte;
  835. end;
  836. procedure tgotonode.ppuwrite(ppufile:tcompilerppufile);
  837. begin
  838. inherited ppuwrite(ppufile);
  839. ppufile.putderef(labsymderef);
  840. ppufile.putbyte(exceptionblock);
  841. end;
  842. procedure tgotonode.buildderefimpl;
  843. begin
  844. inherited buildderefimpl;
  845. labsymderef.build(labsym);
  846. end;
  847. procedure tgotonode.derefimpl;
  848. begin
  849. inherited derefimpl;
  850. labsym:=tlabelsym(labsymderef.resolve);
  851. end;
  852. function tgotonode.det_resulttype:tnode;
  853. begin
  854. result:=nil;
  855. resulttype:=voidtype;
  856. end;
  857. function tgotonode.pass_1 : tnode;
  858. begin
  859. result:=nil;
  860. expectloc:=LOC_VOID;
  861. { check if }
  862. if assigned(labsym) and
  863. assigned(labsym.code) and
  864. (exceptionblock<>tlabelnode(labsym.code).exceptionblock) then
  865. CGMessage(cg_e_goto_inout_of_exception_block);
  866. end;
  867. function tgotonode.getcopy : tnode;
  868. var
  869. p : tgotonode;
  870. begin
  871. p:=tgotonode(inherited getcopy);
  872. p.labsym:=labsym;
  873. p.exceptionblock:=exceptionblock;
  874. result:=p;
  875. end;
  876. function tgotonode.docompare(p: tnode): boolean;
  877. begin
  878. docompare := false;
  879. end;
  880. {*****************************************************************************
  881. TLABELNODE
  882. *****************************************************************************}
  883. constructor tlabelnode.createcase(p : tasmlabel;l:tnode);
  884. begin
  885. inherited create(labeln,l);
  886. { it shouldn't be possible to jump to case labels using goto }
  887. exceptionblock:=-1;
  888. labsym:=nil;
  889. labelnr:=p;
  890. end;
  891. constructor tlabelnode.create(p : tlabelsym;l:tnode);
  892. begin
  893. inherited create(labeln,l);
  894. exceptionblock:=aktexceptblock;
  895. labsym:=p;
  896. labelnr:=p.lab;
  897. { save the current labelnode in the labelsym }
  898. p.code:=self;
  899. end;
  900. constructor tlabelnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  901. begin
  902. inherited ppuload(t,ppufile);
  903. ppufile.getderef(labsymderef);
  904. labelnr:=tasmlabel(ppufile.getasmsymbol);
  905. exceptionblock:=ppufile.getbyte;
  906. end;
  907. procedure tlabelnode.ppuwrite(ppufile:tcompilerppufile);
  908. begin
  909. inherited ppuwrite(ppufile);
  910. ppufile.putderef(labsymderef);
  911. ppufile.putasmsymbol(labelnr);
  912. ppufile.putbyte(exceptionblock);
  913. end;
  914. procedure tlabelnode.buildderefimpl;
  915. begin
  916. inherited buildderefimpl;
  917. labsymderef.build(labsym);
  918. end;
  919. procedure tlabelnode.derefimpl;
  920. begin
  921. inherited derefimpl;
  922. labsym:=tlabelsym(labsymderef.resolve);
  923. objectlibrary.derefasmsymbol(tasmsymbol(labelnr));
  924. end;
  925. function tlabelnode.det_resulttype:tnode;
  926. begin
  927. result:=nil;
  928. { left could still be unassigned }
  929. if assigned(left) then
  930. resulttypepass(left);
  931. resulttype:=voidtype;
  932. end;
  933. function tlabelnode.pass_1 : tnode;
  934. begin
  935. result:=nil;
  936. expectloc:=LOC_VOID;
  937. if assigned(left) then
  938. begin
  939. firstpass(left);
  940. registersint:=left.registersint;
  941. registersfpu:=left.registersfpu;
  942. {$ifdef SUPPORT_MMX}
  943. registersmmx:=left.registersmmx;
  944. {$endif SUPPORT_MMX}
  945. end;
  946. end;
  947. function tlabelnode.getcopy : tnode;
  948. var
  949. p : tlabelnode;
  950. begin
  951. p:=tlabelnode(inherited getcopy);
  952. p.labelnr:=labelnr;
  953. p.exceptionblock:=exceptionblock;
  954. p.labsym:=labsym;
  955. result:=p;
  956. end;
  957. function tlabelnode.docompare(p: tnode): boolean;
  958. begin
  959. docompare := false;
  960. end;
  961. {*****************************************************************************
  962. TRAISENODE
  963. *****************************************************************************}
  964. constructor traisenode.create(l,taddr,tframe:tnode);
  965. begin
  966. inherited create(raisen,l,taddr);
  967. frametree:=tframe;
  968. end;
  969. constructor traisenode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  970. begin
  971. inherited ppuload(t,ppufile);
  972. frametree:=ppuloadnode(ppufile);
  973. end;
  974. procedure traisenode.ppuwrite(ppufile:tcompilerppufile);
  975. begin
  976. inherited ppuwrite(ppufile);
  977. ppuwritenode(ppufile,frametree);
  978. end;
  979. procedure traisenode.buildderefimpl;
  980. begin
  981. inherited buildderefimpl;
  982. if assigned(frametree) then
  983. frametree.buildderefimpl;
  984. end;
  985. procedure traisenode.derefimpl;
  986. begin
  987. inherited derefimpl;
  988. if assigned(frametree) then
  989. frametree.derefimpl;
  990. end;
  991. function traisenode.getcopy : tnode;
  992. var
  993. n : traisenode;
  994. begin
  995. n:=traisenode(inherited getcopy);
  996. if assigned(frametree) then
  997. n.frametree:=frametree.getcopy
  998. else
  999. n.frametree:=nil;
  1000. getcopy:=n;
  1001. end;
  1002. procedure traisenode.insertintolist(l : tnodelist);
  1003. begin
  1004. end;
  1005. function traisenode.det_resulttype:tnode;
  1006. begin
  1007. result:=nil;
  1008. resulttype:=voidtype;
  1009. if assigned(left) then
  1010. begin
  1011. { first para must be a _class_ }
  1012. resulttypepass(left);
  1013. set_varstate(left,vs_used,true);
  1014. if codegenerror then
  1015. exit;
  1016. if not(is_class(left.resulttype.def)) then
  1017. CGMessage1(type_e_class_type_expected,left.resulttype.def.typename);
  1018. { insert needed typeconvs for addr,frame }
  1019. if assigned(right) then
  1020. begin
  1021. { addr }
  1022. resulttypepass(right);
  1023. inserttypeconv(right,voidpointertype);
  1024. { frame }
  1025. if assigned(frametree) then
  1026. begin
  1027. resulttypepass(frametree);
  1028. inserttypeconv(frametree,voidpointertype);
  1029. end;
  1030. end;
  1031. end;
  1032. end;
  1033. function traisenode.pass_1 : tnode;
  1034. begin
  1035. result:=nil;
  1036. include(current_procinfo.flags,pi_do_call);
  1037. expectloc:=LOC_VOID;
  1038. if assigned(left) then
  1039. begin
  1040. { first para must be a _class_ }
  1041. firstpass(left);
  1042. { insert needed typeconvs for addr,frame }
  1043. if assigned(right) then
  1044. begin
  1045. { addr }
  1046. firstpass(right);
  1047. { frame }
  1048. if assigned(frametree) then
  1049. firstpass(frametree);
  1050. end;
  1051. left_right_max;
  1052. end;
  1053. end;
  1054. function traisenode.docompare(p: tnode): boolean;
  1055. begin
  1056. docompare := false;
  1057. end;
  1058. {*****************************************************************************
  1059. TTRYEXCEPTNODE
  1060. *****************************************************************************}
  1061. constructor ttryexceptnode.create(l,r,_t1 : tnode);
  1062. begin
  1063. inherited create(tryexceptn,l,r,_t1,nil);
  1064. end;
  1065. function ttryexceptnode.det_resulttype:tnode;
  1066. begin
  1067. result:=nil;
  1068. resulttypepass(left);
  1069. { on statements }
  1070. if assigned(right) then
  1071. resulttypepass(right);
  1072. { else block }
  1073. if assigned(t1) then
  1074. resulttypepass(t1);
  1075. resulttype:=voidtype;
  1076. end;
  1077. function ttryexceptnode.pass_1 : tnode;
  1078. begin
  1079. result:=nil;
  1080. include(current_procinfo.flags,pi_do_call);
  1081. expectloc:=LOC_VOID;
  1082. firstpass(left);
  1083. { on statements }
  1084. if assigned(right) then
  1085. begin
  1086. firstpass(right);
  1087. registersint:=max(registersint,right.registersint);
  1088. registersfpu:=max(registersfpu,right.registersfpu);
  1089. {$ifdef SUPPORT_MMX}
  1090. registersmmx:=max(registersmmx,right.registersmmx);
  1091. {$endif SUPPORT_MMX}
  1092. end;
  1093. { else block }
  1094. if assigned(t1) then
  1095. begin
  1096. firstpass(t1);
  1097. registersint:=max(registersint,t1.registersint);
  1098. registersfpu:=max(registersfpu,t1.registersfpu);
  1099. {$ifdef SUPPORT_MMX}
  1100. registersmmx:=max(registersmmx,t1.registersmmx);
  1101. {$endif SUPPORT_MMX}
  1102. end;
  1103. end;
  1104. {*****************************************************************************
  1105. TTRYFINALLYNODE
  1106. *****************************************************************************}
  1107. constructor ttryfinallynode.create(l,r:tnode);
  1108. begin
  1109. inherited create(tryfinallyn,l,r,nil,nil);
  1110. implicitframe:=false;
  1111. end;
  1112. constructor ttryfinallynode.create_implicit(l,r,_t1:tnode);
  1113. begin
  1114. inherited create(tryfinallyn,l,r,_t1,nil);
  1115. implicitframe:=true;
  1116. end;
  1117. function ttryfinallynode.det_resulttype:tnode;
  1118. begin
  1119. result:=nil;
  1120. include(current_procinfo.flags,pi_do_call);
  1121. resulttype:=voidtype;
  1122. resulttypepass(left);
  1123. set_varstate(left,vs_used,true);
  1124. resulttypepass(right);
  1125. set_varstate(right,vs_used,true);
  1126. { special finally block only executed when there was an exception }
  1127. if assigned(t1) then
  1128. begin
  1129. resulttypepass(t1);
  1130. set_varstate(t1,vs_used,true);
  1131. end;
  1132. end;
  1133. function ttryfinallynode.pass_1 : tnode;
  1134. begin
  1135. result:=nil;
  1136. expectloc:=LOC_VOID;
  1137. firstpass(left);
  1138. firstpass(right);
  1139. left_right_max;
  1140. if assigned(t1) then
  1141. begin
  1142. firstpass(t1);
  1143. registersint:=max(registersint,t1.registersint);
  1144. registersfpu:=max(registersfpu,t1.registersfpu);
  1145. {$ifdef SUPPORT_MMX}
  1146. registersmmx:=max(registersmmx,t1.registersmmx);
  1147. {$endif SUPPORT_MMX}
  1148. end;
  1149. end;
  1150. {*****************************************************************************
  1151. TONNODE
  1152. *****************************************************************************}
  1153. constructor tonnode.create(l,r:tnode);
  1154. begin
  1155. inherited create(onn,l,r);
  1156. exceptsymtable:=nil;
  1157. excepttype:=nil;
  1158. end;
  1159. destructor tonnode.destroy;
  1160. begin
  1161. { copied nodes don't need to release the symtable }
  1162. if assigned(exceptsymtable) then
  1163. exceptsymtable.free;
  1164. inherited destroy;
  1165. end;
  1166. constructor tonnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  1167. begin
  1168. inherited ppuload(t,ppufile);
  1169. exceptsymtable:=nil;
  1170. excepttype:=nil;
  1171. end;
  1172. function tonnode.getcopy : tnode;
  1173. var
  1174. n : tonnode;
  1175. begin
  1176. n:=tonnode(inherited getcopy);
  1177. n.exceptsymtable:=exceptsymtable.getcopy;
  1178. n.excepttype:=excepttype;
  1179. result:=n;
  1180. end;
  1181. function tonnode.det_resulttype:tnode;
  1182. begin
  1183. result:=nil;
  1184. resulttype:=voidtype;
  1185. if not(is_class(excepttype)) then
  1186. CGMessage1(type_e_class_type_expected,excepttype.typename);
  1187. if assigned(left) then
  1188. resulttypepass(left);
  1189. if assigned(right) then
  1190. resulttypepass(right);
  1191. end;
  1192. function tonnode.pass_1 : tnode;
  1193. begin
  1194. result:=nil;
  1195. include(current_procinfo.flags,pi_do_call);
  1196. expectloc:=LOC_VOID;
  1197. registersint:=0;
  1198. registersfpu:=0;
  1199. {$ifdef SUPPORT_MMX}
  1200. registersmmx:=0;
  1201. {$endif SUPPORT_MMX}
  1202. if assigned(left) then
  1203. begin
  1204. firstpass(left);
  1205. registersint:=left.registersint;
  1206. registersfpu:=left.registersfpu;
  1207. {$ifdef SUPPORT_MMX}
  1208. registersmmx:=left.registersmmx;
  1209. {$endif SUPPORT_MMX}
  1210. end;
  1211. if assigned(right) then
  1212. begin
  1213. firstpass(right);
  1214. registersint:=max(registersint,right.registersint);
  1215. registersfpu:=max(registersfpu,right.registersfpu);
  1216. {$ifdef SUPPORT_MMX}
  1217. registersmmx:=max(registersmmx,right.registersmmx);
  1218. {$endif SUPPORT_MMX}
  1219. end;
  1220. end;
  1221. function tonnode.docompare(p: tnode): boolean;
  1222. begin
  1223. docompare := false;
  1224. end;
  1225. begin
  1226. cwhilerepeatnode:=twhilerepeatnode;
  1227. cifnode:=tifnode;
  1228. cfornode:=tfornode;
  1229. cexitnode:=texitnode;
  1230. cgotonode:=tgotonode;
  1231. clabelnode:=tlabelnode;
  1232. craisenode:=traisenode;
  1233. ctryexceptnode:=ttryexceptnode;
  1234. ctryfinallynode:=ttryfinallynode;
  1235. connode:=tonnode;
  1236. end.
  1237. {
  1238. $Log$
  1239. Revision 1.96 2004-05-23 15:04:13 peter
  1240. * remvoe writeln
  1241. Revision 1.95 2004/03/18 16:19:03 peter
  1242. * fixed operator overload allowing for pointer-string
  1243. * replaced some type_e_mismatch with more informational messages
  1244. Revision 1.94 2004/02/05 01:24:08 florian
  1245. * several fixes to compile x86-64 system
  1246. Revision 1.93 2004/02/03 22:32:54 peter
  1247. * renamed xNNbittype to xNNinttype
  1248. * renamed registers32 to registersint
  1249. * replace some s32bit,u32bit with torddef([su]inttype).def.typ
  1250. Revision 1.92 2004/01/26 16:12:27 daniel
  1251. * reginfo now also only allocated during register allocation
  1252. * third round of gdb cleanups: kick out most of concatstabto
  1253. Revision 1.91 2003/12/28 22:51:18 florian
  1254. + except handling related nodes now include pi_do_call if necessary
  1255. Revision 1.90 2003/12/08 19:29:21 peter
  1256. * copy loopflags
  1257. Revision 1.89 2003/12/01 18:44:15 peter
  1258. * fixed some crashes
  1259. * fixed varargs and register calling probs
  1260. Revision 1.88 2003/11/23 17:39:16 peter
  1261. * don't release exceptsymtable for copied nodes
  1262. Revision 1.87 2003/11/12 15:48:27 peter
  1263. * fix set_varstate in for loops
  1264. * fix set_varstate from case statements
  1265. Revision 1.86 2003/10/28 15:36:01 peter
  1266. * absolute to object field supported, fixes tb0458
  1267. Revision 1.85 2003/10/23 14:44:07 peter
  1268. * splitted buildderef and buildderefimpl to fix interface crc
  1269. calculation
  1270. Revision 1.84 2003/10/22 20:40:00 peter
  1271. * write derefdata in a separate ppu entry
  1272. Revision 1.83 2003/10/09 21:31:37 daniel
  1273. * Register allocator splitted, ans abstract now
  1274. Revision 1.82 2003/10/08 19:19:45 peter
  1275. * set_varstate cleanup
  1276. Revision 1.81 2003/10/05 11:53:57 florian
  1277. * writing of loop nodes fixed
  1278. Revision 1.80 2003/10/01 20:34:48 peter
  1279. * procinfo unit contains tprocinfo
  1280. * cginfo renamed to cgbase
  1281. * moved cgmessage to verbose
  1282. * fixed ppc and sparc compiles
  1283. Revision 1.79 2003/07/06 15:31:20 daniel
  1284. * Fixed register allocator. *Lots* of fixes.
  1285. Revision 1.78 2003/06/13 21:19:30 peter
  1286. * current_procdef removed, use current_procinfo.procdef instead
  1287. Revision 1.77 2003/06/07 20:26:32 peter
  1288. * re-resolving added instead of reloading from ppu
  1289. * tderef object added to store deref info for resolving
  1290. Revision 1.76 2003/06/07 18:57:04 jonas
  1291. + added freeintparaloc
  1292. * ppc get/freeintparaloc now check whether the parameter regs are
  1293. properly allocated/deallocated (and get an extra list para)
  1294. * ppc a_call_* now internalerrors if pi_do_call is not yet set
  1295. * fixed lot of missing pi_do_call's
  1296. Revision 1.75 2003/05/26 21:17:17 peter
  1297. * procinlinenode removed
  1298. * aktexit2label removed, fast exit removed
  1299. + tcallnode.inlined_pass_2 added
  1300. Revision 1.74 2003/05/13 19:14:41 peter
  1301. * failn removed
  1302. * inherited result code check moven to pexpr
  1303. Revision 1.73 2003/05/11 21:37:03 peter
  1304. * moved implicit exception frame from ncgutil to psub
  1305. * constructor/destructor helpers moved from cobj/ncgutil to psub
  1306. Revision 1.72 2003/05/01 07:59:42 florian
  1307. * introduced defaultordconsttype to decribe the default size of ordinal constants
  1308. on 64 bit CPUs it's equal to cs64bitdef while on 32 bit CPUs it's equal to s32bitdef
  1309. + added defines CPU32 and CPU64 for 32 bit and 64 bit CPUs
  1310. * int64s/qwords are allowed as for loop counter on 64 bit CPUs
  1311. Revision 1.71 2003/04/27 11:21:33 peter
  1312. * aktprocdef renamed to current_procinfo.procdef
  1313. * procinfo renamed to current_procinfo
  1314. * procinfo will now be stored in current_module so it can be
  1315. cleaned up properly
  1316. * gen_main_procsym changed to create_main_proc and release_main_proc
  1317. to also generate a tprocinfo structure
  1318. * fixed unit implicit initfinal
  1319. Revision 1.70 2003/04/27 07:29:50 peter
  1320. * current_procinfo.procdef cleanup, current_procdef is now always nil when parsing
  1321. a new procdef declaration
  1322. * aktprocsym removed
  1323. * lexlevel removed, use symtable.symtablelevel instead
  1324. * implicit init/final code uses the normal genentry/genexit
  1325. * funcret state checking updated for new funcret handling
  1326. Revision 1.69 2003/04/26 00:28:41 peter
  1327. * removed load_funcret
  1328. Revision 1.68 2003/04/25 20:59:33 peter
  1329. * removed funcretn,funcretsym, function result is now in varsym
  1330. and aliases for result and function name are added using absolutesym
  1331. * vs_hidden parameter for funcret passed in parameter
  1332. * vs_hidden fixes
  1333. * writenode changed to printnode and released from extdebug
  1334. * -vp option added to generate a tree.log with the nodetree
  1335. * nicer printnode for statements, callnode
  1336. Revision 1.67 2003/04/25 08:25:26 daniel
  1337. * Ifdefs around a lot of calls to cleartempgen
  1338. * Fixed registers that are allocated but not freed in several nodes
  1339. * Tweak to register allocator to cause less spills
  1340. * 8-bit registers now interfere with esi,edi and ebp
  1341. Compiler can now compile rtl successfully when using new register
  1342. allocator
  1343. Revision 1.66 2003/04/22 23:50:23 peter
  1344. * firstpass uses expectloc
  1345. * checks if there are differences between the expectloc and
  1346. location.loc from secondpass in EXTDEBUG
  1347. Revision 1.65 2003/03/20 15:54:46 peter
  1348. * don't allow var and out parameters as for loop counter
  1349. Revision 1.64 2003/01/09 21:52:37 peter
  1350. * merged some verbosity options.
  1351. * V_LineInfo is a verbosity flag to include line info
  1352. Revision 1.63 2003/01/04 08:08:47 daniel
  1353. * Readded missing variable
  1354. Revision 1.62 2003/01/03 17:16:57 peter
  1355. * fixed warning about unset funcret
  1356. Revision 1.61 2003/01/03 12:15:56 daniel
  1357. * Removed ifdefs around notifications
  1358. ifdefs around for loop optimizations remain
  1359. Revision 1.60 2002/12/31 09:55:58 daniel
  1360. + Notification implementation complete
  1361. + Add for loop code optimization using notifications
  1362. results in 1.5-1.9% speed improvement in nestloop benchmark
  1363. Optimization incomplete, compiler does not cycle yet with
  1364. notifications enabled.
  1365. Revision 1.59 2002/12/30 22:44:53 daniel
  1366. * Some work on notifications
  1367. Revision 1.58 2002/12/27 15:25:40 peter
  1368. * do not allow threadvar as loop counter
  1369. Revision 1.57 2002/11/28 11:17:02 florian
  1370. * loop node flags from node flags splitted
  1371. Revision 1.56 2002/11/25 17:43:18 peter
  1372. * splitted defbase in defutil,symutil,defcmp
  1373. * merged isconvertable and is_equal into compare_defs(_ext)
  1374. * made operator search faster by walking the list only once
  1375. Revision 1.55 2002/11/18 17:31:56 peter
  1376. * pass proccalloption to ret_in_xxx and push_xxx functions
  1377. Revision 1.54 2002/10/20 15:31:49 peter
  1378. * set funcret state for exit(0)
  1379. Revision 1.53 2002/10/05 12:43:25 carl
  1380. * fixes for Delphi 6 compilation
  1381. (warning : Some features do not work under Delphi)
  1382. Revision 1.52 2002/09/07 15:25:03 peter
  1383. * old logs removed and tabs fixed
  1384. Revision 1.51 2002/09/07 12:16:04 carl
  1385. * second part bug report 1996 fix, testrange in cordconstnode
  1386. only called if option is set (also make parsing a tiny faster)
  1387. Revision 1.50 2002/09/01 18:47:00 peter
  1388. * assignn check in exitnode changed to use a separate boolean as the
  1389. assignn can be changed to a calln
  1390. Revision 1.49 2002/09/01 08:01:16 daniel
  1391. * Removed sets from Tcallnode.det_resulttype
  1392. + Added read/write notifications of variables. These will be usefull
  1393. for providing information for several optimizations. For example
  1394. the value of the loop variable of a for loop does matter is the
  1395. variable is read after the for loop, but if it's no longer used
  1396. or written, it doesn't matter and this can be used to optimize
  1397. the loop code generation.
  1398. Revision 1.48 2002/08/22 15:15:20 daniel
  1399. * Fixed the detection wether the first check of a for loop can be skipped
  1400. Revision 1.47 2002/08/19 19:36:43 peter
  1401. * More fixes for cross unit inlining, all tnodes are now implemented
  1402. * Moved pocall_internconst to po_internconst because it is not a
  1403. calling type at all and it conflicted when inlining of these small
  1404. functions was requested
  1405. Revision 1.46 2002/08/17 22:09:46 florian
  1406. * result type handling in tcgcal.pass_2 overhauled
  1407. * better tnode.dowrite
  1408. * some ppc stuff fixed
  1409. Revision 1.45 2002/08/17 09:23:37 florian
  1410. * first part of current_procinfo rewrite
  1411. Revision 1.44 2002/07/21 06:58:49 daniel
  1412. * Changed booleans into flags
  1413. Revision 1.43 2002/07/20 11:57:54 florian
  1414. * types.pas renamed to defbase.pas because D6 contains a types
  1415. unit so this would conflicts if D6 programms are compiled
  1416. + Willamette/SSE2 instructions to assembler added
  1417. Revision 1.42 2002/07/20 11:18:18 daniel
  1418. * Small mistake fixed; the skip test was done before we know the for node
  1419. is correct.
  1420. Revision 1.40 2002/07/20 08:19:31 daniel
  1421. * State tracker automatically changes while loops into repeat loops
  1422. Revision 1.39 2002/07/19 12:55:27 daniel
  1423. * Further developed state tracking in whilerepeatn
  1424. Revision 1.38 2002/07/19 11:41:35 daniel
  1425. * State tracker work
  1426. * The whilen and repeatn are now completely unified into whilerepeatn. This
  1427. allows the state tracker to change while nodes automatically into
  1428. repeat nodes.
  1429. * Resulttypepass improvements to the notn. 'not not a' is optimized away and
  1430. 'not(a>b)' is optimized into 'a<=b'.
  1431. * Resulttypepass improvements to the whilerepeatn. 'while not a' is optimized
  1432. by removing the notn and later switchting the true and falselabels. The
  1433. same is done with 'repeat until not a'.
  1434. Revision 1.37 2002/07/16 13:57:02 florian
  1435. * raise takes now a void pointer as at and frame address
  1436. instead of a longint
  1437. Revision 1.36 2002/07/15 18:03:15 florian
  1438. * readded removed changes
  1439. Revision 1.35 2002/07/14 18:00:44 daniel
  1440. + Added the beginning of a state tracker. This will track the values of
  1441. variables through procedures and optimize things away.
  1442. Revision 1.34 2002/07/11 14:41:28 florian
  1443. * start of the new generic parameter handling
  1444. Revision 1.33 2002/07/01 18:46:23 peter
  1445. * internal linker
  1446. * reorganized aasm layer
  1447. Revision 1.32 2002/05/18 13:34:10 peter
  1448. * readded missing revisions
  1449. Revision 1.31 2002/05/16 19:46:38 carl
  1450. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  1451. + try to fix temp allocation (still in ifdef)
  1452. + generic constructor calls
  1453. + start of tassembler / tmodulebase class cleanup
  1454. }