nflw.pas 55 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838
  1. {
  2. Copyright (c) 1998-2002 by Florian Klaempfl
  3. Type checking and register allocation for nodes that influence
  4. the flow
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit nflw;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. cclasses,
  23. node,cpubase,
  24. symnot,
  25. symtype,symbase,symdef,symsym,
  26. optloop;
  27. type
  28. { flags used by loop nodes }
  29. tloopflag = (
  30. { set if it is a for ... downto ... do loop }
  31. lnf_backward,
  32. { Do we need to parse childs to set var state? }
  33. lnf_varstate,
  34. { Do a test at the begin of the loop?}
  35. lnf_testatbegin,
  36. { Negate the loop test? }
  37. lnf_checknegate,
  38. { Should the value of the loop variable on exit be correct. }
  39. lnf_dont_mind_loopvar_on_exit);
  40. tloopflags = set of tloopflag;
  41. const
  42. { loop flags which must match to consider loop nodes equal regarding the flags }
  43. loopflagsequal = [lnf_backward];
  44. type
  45. tlabelnode = class;
  46. tloopnode = class(tbinarynode)
  47. t1,t2 : tnode;
  48. loopflags : tloopflags;
  49. constructor create(tt : tnodetype;l,r,_t1,_t2 : tnode);virtual;
  50. destructor destroy;override;
  51. function dogetcopy : tnode;override;
  52. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  53. procedure ppuwrite(ppufile:tcompilerppufile);override;
  54. procedure buildderefimpl;override;
  55. procedure derefimpl;override;
  56. procedure insertintolist(l : tnodelist);override;
  57. procedure printnodetree(var t:text);override;
  58. function docompare(p: tnode): boolean; override;
  59. end;
  60. twhilerepeatnode = class(tloopnode)
  61. constructor create(l,r:Tnode;tab,cn:boolean);virtual;reintroduce;
  62. function pass_typecheck:tnode;override;
  63. function pass_1 : tnode;override;
  64. {$ifdef state_tracking}
  65. function track_state_pass(exec_known:boolean):boolean;override;
  66. {$endif}
  67. end;
  68. twhilerepeatnodeclass = class of twhilerepeatnode;
  69. tifnode = class(tloopnode)
  70. constructor create(l,r,_t1 : tnode);virtual;reintroduce;
  71. function pass_typecheck:tnode;override;
  72. function pass_1 : tnode;override;
  73. function simplify : tnode;override;
  74. private
  75. function internalsimplify(warn: boolean) : tnode;
  76. end;
  77. tifnodeclass = class of tifnode;
  78. tfornode = class(tloopnode)
  79. { if count isn divisable by unrolls then
  80. the for loop must jump to this label to get the correct
  81. number of executions }
  82. entrylabel : tnode;
  83. loopvar_notid:cardinal;
  84. constructor create(l,r,_t1,_t2 : tnode;back : boolean);virtual;reintroduce;
  85. procedure loop_var_access(not_type:Tnotification_flag;symbol:Tsym);
  86. function pass_typecheck:tnode;override;
  87. function pass_1 : tnode;override;
  88. function simplify : tnode;override;
  89. end;
  90. tfornodeclass = class of tfornode;
  91. texitnode = class(tunarynode)
  92. constructor create(l:tnode);virtual;
  93. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  94. procedure ppuwrite(ppufile:tcompilerppufile);override;
  95. function pass_typecheck:tnode;override;
  96. function pass_1 : tnode;override;
  97. end;
  98. texitnodeclass = class of texitnode;
  99. tbreaknode = class(tnode)
  100. constructor create;virtual;
  101. function pass_typecheck:tnode;override;
  102. function pass_1 : tnode;override;
  103. end;
  104. tbreaknodeclass = class of tbreaknode;
  105. tcontinuenode = class(tnode)
  106. constructor create;virtual;
  107. function pass_typecheck:tnode;override;
  108. function pass_1 : tnode;override;
  109. end;
  110. tcontinuenodeclass = class of tcontinuenode;
  111. tgotonode = class(tnode)
  112. private
  113. labelnodeidx : longint;
  114. public
  115. labelsym : tlabelsym;
  116. labelnode : tlabelnode;
  117. exceptionblock : integer;
  118. constructor create(p : tlabelsym);virtual;
  119. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  120. procedure ppuwrite(ppufile:tcompilerppufile);override;
  121. procedure buildderefimpl;override;
  122. procedure derefimpl;override;
  123. procedure resolveppuidx;override;
  124. function dogetcopy : tnode;override;
  125. function pass_typecheck:tnode;override;
  126. function pass_1 : tnode;override;
  127. function docompare(p: tnode): boolean; override;
  128. end;
  129. tgotonodeclass = class of tgotonode;
  130. tlabelnode = class(tunarynode)
  131. exceptionblock : integer;
  132. { when copying trees, this points to the newly created copy of a label }
  133. copiedto : tlabelnode;
  134. labsym : tlabelsym;
  135. constructor create(l:tnode;alabsym:tlabelsym);virtual;
  136. destructor destroy;override;
  137. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  138. procedure ppuwrite(ppufile:tcompilerppufile);override;
  139. procedure buildderefimpl;override;
  140. procedure derefimpl;override;
  141. function dogetcopy : tnode;override;
  142. function pass_typecheck:tnode;override;
  143. function pass_1 : tnode;override;
  144. function docompare(p: tnode): boolean; override;
  145. end;
  146. tlabelnodeclass = class of tlabelnode;
  147. traisenode = class(ttertiarynode)
  148. constructor create(l,taddr,tframe:tnode);virtual;
  149. function pass_typecheck:tnode;override;
  150. function pass_1 : tnode;override;
  151. end;
  152. traisenodeclass = class of traisenode;
  153. ttryexceptnode = class(tloopnode)
  154. constructor create(l,r,_t1 : tnode);virtual;reintroduce;
  155. function pass_typecheck:tnode;override;
  156. function pass_1 : tnode;override;
  157. end;
  158. ttryexceptnodeclass = class of ttryexceptnode;
  159. ttryfinallynode = class(tloopnode)
  160. implicitframe : boolean;
  161. constructor create(l,r:tnode);virtual;reintroduce;
  162. constructor create_implicit(l,r,_t1:tnode);virtual;
  163. function pass_typecheck:tnode;override;
  164. function pass_1 : tnode;override;
  165. function simplify: tnode;override;
  166. end;
  167. ttryfinallynodeclass = class of ttryfinallynode;
  168. tonnode = class(tbinarynode)
  169. excepTSymtable : TSymtable;
  170. excepttype : tobjectdef;
  171. constructor create(l,r:tnode);virtual;
  172. destructor destroy;override;
  173. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  174. function pass_typecheck:tnode;override;
  175. function pass_1 : tnode;override;
  176. function dogetcopy : tnode;override;
  177. function docompare(p: tnode): boolean; override;
  178. end;
  179. tonnodeclass = class of tonnode;
  180. var
  181. cwhilerepeatnode : twhilerepeatnodeclass;
  182. cifnode : tifnodeclass;
  183. cfornode : tfornodeclass;
  184. cexitnode : texitnodeclass;
  185. cbreaknode : tbreaknodeclass;
  186. ccontinuenode : tcontinuenodeclass;
  187. cgotonode : tgotonodeclass;
  188. clabelnode : tlabelnodeclass;
  189. craisenode : traisenodeclass;
  190. ctryexceptnode : ttryexceptnodeclass;
  191. ctryfinallynode : ttryfinallynodeclass;
  192. connode : tonnodeclass;
  193. // for-in loop helpers
  194. function create_type_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  195. function create_string_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  196. function create_array_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  197. function create_set_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  198. function create_enumerator_for_in_loop(hloopvar, hloopbody, expr: tnode;
  199. enumerator_get, enumerator_move: tprocdef; enumerator_current: tpropertysym): tnode;
  200. function create_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  201. implementation
  202. uses
  203. globtype,systems,constexp,
  204. cutils,verbose,globals,
  205. symconst,symtable,paramgr,defcmp,defutil,htypechk,pass_1,
  206. ncal,nadd,ncon,nmem,nld,ncnv,nbas,cgobj,nutils,ninl,nset,
  207. {$ifdef state_tracking}
  208. nstate,
  209. {$endif}
  210. cgbase,procinfo
  211. ;
  212. // for-in loop helpers
  213. function create_type_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  214. begin
  215. result:=cfornode.create(hloopvar,
  216. cinlinenode.create(in_low_x,false,expr.getcopy),
  217. cinlinenode.create(in_high_x,false,expr.getcopy),
  218. hloopbody,
  219. false);
  220. end;
  221. function create_string_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  222. var
  223. loopstatement, loopbodystatement: tstatementnode;
  224. loopvar, stringvar: ttempcreatenode;
  225. stringindex, loopbody, forloopnode: tnode;
  226. begin
  227. { result is a block of statements }
  228. result:=internalstatements(loopstatement);
  229. { create a temp variable for expression }
  230. stringvar := ctempcreatenode.create(
  231. expr.resultdef,
  232. expr.resultdef.size,
  233. tt_persistent,true);
  234. addstatement(loopstatement,stringvar);
  235. addstatement(loopstatement,cassignmentnode.create(ctemprefnode.create(stringvar),expr.getcopy));
  236. { create a loop counter: signed integer with size of string length }
  237. loopvar := ctempcreatenode.create(
  238. sinttype,
  239. sinttype.size,
  240. tt_persistent,true);
  241. addstatement(loopstatement,loopvar);
  242. stringindex:=ctemprefnode.create(loopvar);
  243. loopbody:=internalstatements(loopbodystatement);
  244. // for-in loop variable := string_expression[index]
  245. addstatement(loopbodystatement,
  246. cassignmentnode.create(hloopvar, cvecnode.create(ctemprefnode.create(stringvar),stringindex)));
  247. { add the actual statement to the loop }
  248. addstatement(loopbodystatement,hloopbody);
  249. forloopnode:=cfornode.create(ctemprefnode.create(loopvar),
  250. genintconstnode(1),
  251. cinlinenode.create(in_length_x,false,ctemprefnode.create(stringvar)),
  252. loopbody,
  253. false);
  254. addstatement(loopstatement,forloopnode);
  255. { free the loop counter }
  256. addstatement(loopstatement,ctempdeletenode.create(loopvar));
  257. { free the temp variable for expression }
  258. addstatement(loopstatement,ctempdeletenode.create(stringvar));
  259. end;
  260. function create_array_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  261. var
  262. loopstatement, loopbodystatement: tstatementnode;
  263. loopvar, arrayvar: ttempcreatenode;
  264. arrayindex, lowbound, highbound, loopbody, forloopnode, expression: tnode;
  265. is_string: boolean;
  266. tmpdef, convertdef: tdef;
  267. elementcount: aword;
  268. begin
  269. expression := expr;
  270. { result is a block of statements }
  271. result:=internalstatements(loopstatement);
  272. is_string:=ado_IsConstString in tarraydef(expr.resultdef).arrayoptions;
  273. // if array element type <> loovar type then create a conversion if possible
  274. if compare_defs(tarraydef(expression.resultdef).elementdef,hloopvar.resultdef,nothingn)=te_incompatible then
  275. begin
  276. tmpdef:=expression.resultdef;
  277. elementcount:=1;
  278. while assigned(tmpdef) and (tmpdef.typ=arraydef) and
  279. (tarraydef(tmpdef).arrayoptions = []) and
  280. (compare_defs(tarraydef(tmpdef).elementdef,hloopvar.resultdef,nothingn)=te_incompatible) do
  281. begin
  282. elementcount:=elementcount*tarraydef(tmpdef).elecount;
  283. tmpdef:=tarraydef(tmpdef).elementdef;
  284. end;
  285. if assigned(tmpdef) and (tmpdef.typ=arraydef) and (tarraydef(tmpdef).arrayoptions = []) then
  286. begin
  287. elementcount:=elementcount*tarraydef(tmpdef).elecount;
  288. convertdef:=tarraydef.create(0,elementcount-1,s32inttype);
  289. tarraydef(convertdef).elementdef:=tarraydef(tmpdef).elementdef;
  290. expression:=expr.getcopy;
  291. expression:=ctypeconvnode.create_internal(expression,convertdef);
  292. typecheckpass(expression);
  293. addstatement(loopstatement,expression);
  294. end;
  295. end;
  296. if (node_complexity(expression) > 1) and not is_open_array(expression.resultdef) then
  297. begin
  298. { create a temp variable for expression }
  299. arrayvar := ctempcreatenode.create(
  300. expression.resultdef,
  301. expression.resultdef.size,
  302. tt_persistent,true);
  303. if is_string then
  304. begin
  305. lowbound:=genintconstnode(1);
  306. highbound:=cinlinenode.create(in_length_x,false,ctemprefnode.create(arrayvar))
  307. end
  308. else
  309. begin
  310. lowbound:=cinlinenode.create(in_low_x,false,ctemprefnode.create(arrayvar));
  311. highbound:=cinlinenode.create(in_high_x,false,ctemprefnode.create(arrayvar));
  312. end;
  313. addstatement(loopstatement,arrayvar);
  314. addstatement(loopstatement,cassignmentnode.create(ctemprefnode.create(arrayvar),expression.getcopy));
  315. end
  316. else
  317. begin
  318. arrayvar:=nil;
  319. if is_string then
  320. begin
  321. lowbound:=genintconstnode(1);
  322. highbound:=cinlinenode.create(in_length_x,false,expression.getcopy);
  323. end
  324. else
  325. begin
  326. lowbound:=cinlinenode.create(in_low_x,false,expression.getcopy);
  327. highbound:=cinlinenode.create(in_high_x,false,expression.getcopy);
  328. end;
  329. end;
  330. { create a loop counter }
  331. loopvar := ctempcreatenode.create(
  332. tarraydef(expression.resultdef).rangedef,
  333. tarraydef(expression.resultdef).rangedef.size,
  334. tt_persistent,true);
  335. addstatement(loopstatement,loopvar);
  336. arrayindex:=ctemprefnode.create(loopvar);
  337. loopbody:=internalstatements(loopbodystatement);
  338. // for-in loop variable := array_expression[index]
  339. if assigned(arrayvar) then
  340. addstatement(loopbodystatement,
  341. cassignmentnode.create(hloopvar,cvecnode.create(ctemprefnode.create(arrayvar),arrayindex)))
  342. else
  343. addstatement(loopbodystatement,
  344. cassignmentnode.create(hloopvar,cvecnode.create(expression.getcopy,arrayindex)));
  345. { add the actual statement to the loop }
  346. addstatement(loopbodystatement,hloopbody);
  347. forloopnode:=cfornode.create(ctemprefnode.create(loopvar),
  348. lowbound,
  349. highbound,
  350. loopbody,
  351. false);
  352. addstatement(loopstatement,forloopnode);
  353. { free the loop counter }
  354. addstatement(loopstatement,ctempdeletenode.create(loopvar));
  355. { free the temp variable for expression if needed }
  356. if arrayvar<>nil then
  357. addstatement(loopstatement,ctempdeletenode.create(arrayvar));
  358. end;
  359. function create_set_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  360. var
  361. loopstatement, loopbodystatement: tstatementnode;
  362. loopvar, setvar: ttempcreatenode;
  363. loopbody, forloopnode: tnode;
  364. begin
  365. // first check is set is empty and if it so then skip other processing
  366. if not Assigned(tsetdef(expr.resultdef).elementdef) then
  367. begin
  368. result:=cnothingnode.create;
  369. // free unused nodes
  370. hloopvar.free;
  371. hloopbody.free;
  372. exit;
  373. end;
  374. { result is a block of statements }
  375. result:=internalstatements(loopstatement);
  376. { create a temp variable for expression }
  377. setvar := ctempcreatenode.create(
  378. expr.resultdef,
  379. expr.resultdef.size,
  380. tt_persistent,true);
  381. addstatement(loopstatement,setvar);
  382. addstatement(loopstatement,cassignmentnode.create(ctemprefnode.create(setvar),expr.getcopy));
  383. { create a loop counter }
  384. loopvar := ctempcreatenode.create(
  385. tsetdef(expr.resultdef).elementdef,
  386. tsetdef(expr.resultdef).elementdef.size,
  387. tt_persistent,true);
  388. addstatement(loopstatement,loopvar);
  389. // if loopvar in set then
  390. // begin
  391. // hloopvar := loopvar
  392. // for-in loop body
  393. // end
  394. loopbody:=cifnode.create(
  395. cinnode.create(ctemprefnode.create(loopvar),ctemprefnode.create(setvar)),
  396. internalstatements(loopbodystatement),
  397. nil
  398. );
  399. addstatement(loopbodystatement,cassignmentnode.create(hloopvar,ctemprefnode.create(loopvar)));
  400. { add the actual statement to the loop }
  401. addstatement(loopbodystatement,hloopbody);
  402. forloopnode:=cfornode.create(ctemprefnode.create(loopvar),
  403. cinlinenode.create(in_low_x,false,ctemprefnode.create(setvar)),
  404. cinlinenode.create(in_high_x,false,ctemprefnode.create(setvar)),
  405. loopbody,
  406. false);
  407. addstatement(loopstatement,forloopnode);
  408. { free the loop counter }
  409. addstatement(loopstatement,ctempdeletenode.create(loopvar));
  410. { free the temp variable for expression }
  411. addstatement(loopstatement,ctempdeletenode.create(setvar));
  412. end;
  413. function create_enumerator_for_in_loop(hloopvar, hloopbody, expr: tnode;
  414. enumerator_get, enumerator_move: tprocdef; enumerator_current: tpropertysym): tnode;
  415. var
  416. loopstatement, loopbodystatement: tstatementnode;
  417. enumvar: ttempcreatenode;
  418. loopbody, whileloopnode,
  419. enum_get, enum_move, enum_current, enum_get_params: tnode;
  420. propaccesslist: tpropaccesslist;
  421. enumerator_is_class: boolean;
  422. enumerator_destructor: tprocdef;
  423. begin
  424. { result is a block of statements }
  425. result:=internalstatements(loopstatement);
  426. enumerator_is_class := is_class(enumerator_get.returndef);
  427. { create a temp variable for enumerator }
  428. enumvar := ctempcreatenode.create(
  429. enumerator_get.returndef,
  430. enumerator_get.returndef.size,
  431. tt_persistent,true);
  432. addstatement(loopstatement,enumvar);
  433. if enumerator_get.proctypeoption=potype_operator then
  434. begin
  435. enum_get_params:=ccallparanode.create(expr.getcopy,nil);
  436. enum_get:=ccallnode.create(enum_get_params, tprocsym(enumerator_get.procsym), nil, nil, []);
  437. tcallnode(enum_get).procdefinition:=enumerator_get;
  438. addsymref(enumerator_get.procsym);
  439. end
  440. else
  441. enum_get:=ccallnode.create(nil, tprocsym(enumerator_get.procsym), enumerator_get.owner, expr.getcopy, []);
  442. addstatement(loopstatement,
  443. cassignmentnode.create(
  444. ctemprefnode.create(enumvar),
  445. enum_get
  446. ));
  447. loopbody:=internalstatements(loopbodystatement);
  448. { for-in loop variable := enumerator.current }
  449. if getpropaccesslist(enumerator_current,palt_read,propaccesslist) then
  450. begin
  451. case propaccesslist.firstsym^.sym.typ of
  452. fieldvarsym :
  453. begin
  454. { generate access code }
  455. enum_current:=ctemprefnode.create(enumvar);
  456. propaccesslist_to_node(enum_current,enumerator_current.owner,propaccesslist);
  457. include(enum_current.flags,nf_isproperty);
  458. end;
  459. procsym :
  460. begin
  461. { generate the method call }
  462. enum_current:=ccallnode.create(nil,tprocsym(propaccesslist.firstsym^.sym),enumerator_current.owner,ctemprefnode.create(enumvar),[]);
  463. include(enum_current.flags,nf_isproperty);
  464. end
  465. else
  466. begin
  467. enum_current:=cerrornode.create;
  468. Message(type_e_mismatch);
  469. end;
  470. end;
  471. end
  472. else
  473. enum_current:=cerrornode.create;
  474. addstatement(loopbodystatement,
  475. cassignmentnode.create(hloopvar, enum_current));
  476. { add the actual statement to the loop }
  477. addstatement(loopbodystatement,hloopbody);
  478. enum_move:=ccallnode.create(nil, tprocsym(enumerator_move.procsym), enumerator_move.owner, ctemprefnode.create(enumvar), []);
  479. whileloopnode:=cwhilerepeatnode.create(enum_move,loopbody,true,false);
  480. if enumerator_is_class then
  481. begin
  482. { insert a try-finally and call the destructor for the enumerator in the finally section }
  483. enumerator_destructor:=tobjectdef(enumerator_get.returndef).Finddestructor;
  484. if assigned(enumerator_destructor) then
  485. begin
  486. whileloopnode:=ctryfinallynode.create(
  487. whileloopnode, // try node
  488. ccallnode.create(nil,tprocsym(enumerator_destructor.procsym), // finally node
  489. enumerator_destructor.procsym.owner,ctemprefnode.create(enumvar),[]));
  490. end;
  491. { if getenumerator <> nil then do the loop }
  492. whileloopnode:=cifnode.create(
  493. caddnode.create(unequaln, ctemprefnode.create(enumvar), cnilnode.create),
  494. whileloopnode,
  495. nil
  496. );
  497. end;
  498. addstatement(loopstatement, whileloopnode);
  499. if is_object(enumerator_get.returndef) then
  500. begin
  501. // call the object destructor too
  502. enumerator_destructor:=tobjectdef(enumerator_get.returndef).Finddestructor;
  503. if assigned(enumerator_destructor) then
  504. begin
  505. addstatement(loopstatement,
  506. ccallnode.create(nil,tprocsym(enumerator_destructor.procsym),
  507. enumerator_destructor.procsym.owner,ctemprefnode.create(enumvar),[]));
  508. end;
  509. end;
  510. { free the temp variable for enumerator }
  511. addstatement(loopstatement,ctempdeletenode.create(enumvar));
  512. end;
  513. function create_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  514. var
  515. pd, movenext: tprocdef;
  516. current: tpropertysym;
  517. storefilepos: tfileposinfo;
  518. begin
  519. storefilepos:=current_filepos;
  520. current_filepos:=hloopvar.fileinfo;
  521. if expr.nodetype=typen then
  522. begin
  523. if (expr.resultdef.typ=enumdef) and tenumdef(expr.resultdef).has_jumps then
  524. begin
  525. result:=cerrornode.create;
  526. hloopvar.free;
  527. hloopbody.free;
  528. MessagePos1(expr.fileinfo,parser_e_for_in_loop_cannot_be_used_for_the_type,expr.resultdef.typename);
  529. end
  530. else
  531. result:=create_type_for_in_loop(hloopvar, hloopbody, expr);
  532. end
  533. else
  534. begin
  535. { loop is made for an expression }
  536. // search for operator first
  537. pd:=search_enumerator_operator(expr.resultdef);
  538. // if there is no operator then search for class/object enumerator method
  539. if (pd=nil) and (expr.resultdef.typ=objectdef) then
  540. pd:=tobjectdef(expr.resultdef).search_enumerator_get;
  541. if pd<>nil then
  542. begin
  543. // seach movenext and current symbols
  544. movenext:=tobjectdef(pd.returndef).search_enumerator_move;
  545. if movenext = nil then
  546. begin
  547. result:=cerrornode.create;
  548. hloopvar.free;
  549. hloopbody.free;
  550. MessagePos1(expr.fileinfo,sym_e_no_enumerator_move,pd.returndef.GetTypeName);
  551. end
  552. else
  553. begin
  554. current:=tpropertysym(tobjectdef(pd.returndef).search_enumerator_current);
  555. if current = nil then
  556. begin
  557. result:=cerrornode.create;
  558. hloopvar.free;
  559. hloopbody.free;
  560. MessagePos1(expr.fileinfo,sym_e_no_enumerator_current,pd.returndef.GetTypeName);
  561. end
  562. else
  563. result:=create_enumerator_for_in_loop(hloopvar, hloopbody, expr, pd, movenext, current);
  564. end;
  565. end
  566. else
  567. begin
  568. case expr.resultdef.typ of
  569. stringdef: result:=create_string_for_in_loop(hloopvar, hloopbody, expr);
  570. arraydef: result:=create_array_for_in_loop(hloopvar, hloopbody, expr);
  571. setdef: result:=create_set_for_in_loop(hloopvar, hloopbody, expr);
  572. else
  573. begin
  574. result:=cerrornode.create;
  575. hloopvar.free;
  576. hloopbody.free;
  577. MessagePos1(expr.fileinfo,sym_e_no_enumerator,expr.resultdef.GetTypeName);
  578. end;
  579. end;
  580. end;
  581. end;
  582. current_filepos:=storefilepos;
  583. end;
  584. {****************************************************************************
  585. TLOOPNODE
  586. *****************************************************************************}
  587. constructor tloopnode.create(tt : tnodetype;l,r,_t1,_t2 : tnode);
  588. begin
  589. inherited create(tt,l,r);
  590. t1:=_t1;
  591. t2:=_t2;
  592. fileinfo:=l.fileinfo;
  593. end;
  594. destructor tloopnode.destroy;
  595. begin
  596. t1.free;
  597. t2.free;
  598. inherited destroy;
  599. end;
  600. constructor tloopnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  601. begin
  602. inherited ppuload(t,ppufile);
  603. t1:=ppuloadnode(ppufile);
  604. t2:=ppuloadnode(ppufile);
  605. end;
  606. procedure tloopnode.ppuwrite(ppufile:tcompilerppufile);
  607. begin
  608. inherited ppuwrite(ppufile);
  609. ppuwritenode(ppufile,t1);
  610. ppuwritenode(ppufile,t2);
  611. end;
  612. procedure tloopnode.buildderefimpl;
  613. begin
  614. inherited buildderefimpl;
  615. if assigned(t1) then
  616. t1.buildderefimpl;
  617. if assigned(t2) then
  618. t2.buildderefimpl;
  619. end;
  620. procedure tloopnode.derefimpl;
  621. begin
  622. inherited derefimpl;
  623. if assigned(t1) then
  624. t1.derefimpl;
  625. if assigned(t2) then
  626. t2.derefimpl;
  627. end;
  628. function tloopnode.dogetcopy : tnode;
  629. var
  630. p : tloopnode;
  631. begin
  632. p:=tloopnode(inherited dogetcopy);
  633. if assigned(t1) then
  634. p.t1:=t1.dogetcopy
  635. else
  636. p.t1:=nil;
  637. if assigned(t2) then
  638. p.t2:=t2.dogetcopy
  639. else
  640. p.t2:=nil;
  641. p.loopflags:=loopflags;
  642. dogetcopy:=p;
  643. end;
  644. procedure tloopnode.insertintolist(l : tnodelist);
  645. begin
  646. end;
  647. procedure tloopnode.printnodetree(var t:text);
  648. begin
  649. write(t,printnodeindention,'(');
  650. printnodeindent;
  651. printnodeinfo(t);
  652. writeln(t);
  653. printnode(t,left);
  654. printnode(t,right);
  655. printnode(t,t1);
  656. printnode(t,t2);
  657. printnodeunindent;
  658. writeln(t,printnodeindention,')');
  659. end;
  660. function tloopnode.docompare(p: tnode): boolean;
  661. begin
  662. docompare :=
  663. inherited docompare(p) and
  664. (loopflags*loopflagsequal=tloopnode(p).loopflags*loopflagsequal) and
  665. t1.isequal(tloopnode(p).t1) and
  666. t2.isequal(tloopnode(p).t2);
  667. end;
  668. {****************************************************************************
  669. TWHILEREPEATNODE
  670. *****************************************************************************}
  671. constructor Twhilerepeatnode.create(l,r:Tnode;tab,cn:boolean);
  672. begin
  673. inherited create(whilerepeatn,l,r,nil,nil);
  674. if tab then
  675. include(loopflags, lnf_testatbegin);
  676. if cn then
  677. include(loopflags,lnf_checknegate);
  678. end;
  679. function twhilerepeatnode.pass_typecheck:tnode;
  680. var
  681. t:Tunarynode;
  682. begin
  683. result:=nil;
  684. resultdef:=voidtype;
  685. typecheckpass(left);
  686. { tp procvar support }
  687. maybe_call_procvar(left,true);
  688. {A not node can be removed.}
  689. if left.nodetype=notn then
  690. begin
  691. t:=Tunarynode(left);
  692. left:=Tunarynode(left).left;
  693. t.left:=nil;
  694. t.destroy;
  695. {Symdif operator, in case you are wondering:}
  696. loopflags:=loopflags >< [lnf_checknegate];
  697. end;
  698. { loop instruction }
  699. if assigned(right) then
  700. typecheckpass(right);
  701. set_varstate(left,vs_read,[vsf_must_be_valid]);
  702. if codegenerror then
  703. exit;
  704. if not is_boolean(left.resultdef) then
  705. begin
  706. if left.resultdef.typ=variantdef then
  707. inserttypeconv(left,booltype)
  708. else
  709. CGMessage1(type_e_boolean_expr_expected,left.resultdef.typename);
  710. end;
  711. { Give warnings for code that will never be executed for
  712. while false do }
  713. if (lnf_testatbegin in loopflags) and
  714. (left.nodetype=ordconstn) and
  715. (tordconstnode(left).value.uvalue=0) and
  716. assigned(right) then
  717. CGMessagePos(right.fileinfo,cg_w_unreachable_code);
  718. end;
  719. {$ifdef prefetchnext}
  720. type
  721. passignmentquery = ^tassignmentquery;
  722. tassignmentquery = record
  723. towhat: tnode;
  724. source: tassignmentnode;
  725. statementcount: cardinal;
  726. end;
  727. function checkassignment(var n: tnode; arg: pointer): foreachnoderesult;
  728. var
  729. query: passignmentquery absolute arg;
  730. temp, prederef: tnode;
  731. begin
  732. result := fen_norecurse_false;
  733. if (n.nodetype in [assignn,inlinen,forn,calln,whilerepeatn,casen,ifn]) then
  734. inc(query^.statementcount);
  735. { make sure there's something else in the loop besides going to the }
  736. { next item }
  737. if (query^.statementcount > 1) and
  738. (n.nodetype = assignn) then
  739. begin
  740. { skip type conversions of assignment target }
  741. temp := tassignmentnode(n).left;
  742. while (temp.nodetype = typeconvn) do
  743. temp := ttypeconvnode(temp).left;
  744. { assignment to x of the while assigned(x) check? }
  745. if not(temp.isequal(query^.towhat)) then
  746. exit;
  747. { right hand side of assignment dereferenced field of }
  748. { x? (no derefn in case of class) }
  749. temp := tassignmentnode(n).right;
  750. while (temp.nodetype = typeconvn) do
  751. temp := ttypeconvnode(temp).left;
  752. if (temp.nodetype <> subscriptn) then
  753. exit;
  754. prederef := tsubscriptnode(temp).left;
  755. temp := prederef;
  756. while (temp.nodetype = typeconvn) do
  757. temp := ttypeconvnode(temp).left;
  758. { see tests/test/prefetch1.pp }
  759. if (temp.nodetype = derefn) then
  760. temp := tderefnode(temp).left
  761. else
  762. temp := prederef;
  763. if temp.isequal(query^.towhat) then
  764. begin
  765. query^.source := tassignmentnode(n);
  766. result := fen_norecurse_true;
  767. end
  768. end
  769. { don't check nodes which can't contain an assignment or whose }
  770. { final assignment can vary a lot }
  771. else if not(n.nodetype in [calln,inlinen,casen,whilerepeatn,forn]) then
  772. result := fen_false;
  773. end;
  774. function findassignment(where: tnode; towhat: tnode): tassignmentnode;
  775. var
  776. query: tassignmentquery;
  777. begin
  778. query.towhat := towhat;
  779. query.source := nil;
  780. query.statementcount := 0;
  781. if foreachnodestatic(where,@checkassignment,@query) then
  782. result := query.source
  783. else
  784. result := nil;
  785. end;
  786. {$endif prefetchnext}
  787. function twhilerepeatnode.pass_1 : tnode;
  788. {$ifdef prefetchnext}
  789. var
  790. runnernode, prefetchcode: tnode;
  791. assignmentnode: tassignmentnode;
  792. prefetchstatements: tstatementnode;
  793. {$endif prefetchnext}
  794. begin
  795. result:=nil;
  796. expectloc:=LOC_VOID;
  797. firstpass(left);
  798. if codegenerror then
  799. exit;
  800. { loop instruction }
  801. if assigned(right) then
  802. begin
  803. firstpass(right);
  804. if codegenerror then
  805. exit;
  806. end;
  807. {$ifdef prefetchnext}
  808. { do at the end so all complex typeconversions are already }
  809. { converted to calln's }
  810. if (cs_opt_level1 in current_settings.optimizerswitches) and
  811. (lnf_testatbegin in loopflags) then
  812. begin
  813. { get first component of the while check }
  814. runnernode := left;
  815. while (runnernode.nodetype in [andn,orn,notn,xorn,typeconvn]) do
  816. runnernode := tunarynode(runnernode).left;
  817. { is it an assigned(x) check? }
  818. if ((runnernode.nodetype = inlinen) and
  819. (tinlinenode(runnernode).inlinenumber = in_assigned_x)) or
  820. ((runnernode.nodetype = unequaln) and
  821. (taddnode(runnernode).right.nodetype = niln)) then
  822. begin
  823. runnernode := tunarynode(runnernode).left;
  824. { in case of in_assigned_x, there's a callparan in between }
  825. if (runnernode.nodetype = callparan) then
  826. runnernode := tcallparanode(runnernode).left;
  827. while (runnernode.nodetype = typeconvn) do
  828. runnernode := ttypeconvnode(runnernode).left;
  829. { is there an "x := x(^).somefield"? }
  830. assignmentnode := findassignment(right,runnernode);
  831. if assigned(assignmentnode) then
  832. begin
  833. prefetchcode := internalstatements(prefetchstatements);
  834. addstatement(prefetchstatements,geninlinenode(in_prefetch_var,false,
  835. cderefnode.create(ctypeconvnode.create(assignmentnode.right.getcopy,voidpointertype))));
  836. addstatement(prefetchstatements,right);
  837. right := prefetchcode;
  838. typecheckpass(right);
  839. end;
  840. end;
  841. end;
  842. {$endif prefetchnext}
  843. end;
  844. {$ifdef state_tracking}
  845. function Twhilerepeatnode.track_state_pass(exec_known:boolean):boolean;
  846. var condition:Tnode;
  847. code:Tnode;
  848. done:boolean;
  849. value:boolean;
  850. change:boolean;
  851. firsttest:boolean;
  852. factval:Tnode;
  853. begin
  854. track_state_pass:=false;
  855. done:=false;
  856. firsttest:=true;
  857. {For repeat until statements, first do a pass through the code.}
  858. if not(lnf_testatbegin in flags) then
  859. begin
  860. code:=right.getcopy;
  861. if code.track_state_pass(exec_known) then
  862. track_state_pass:=true;
  863. code.destroy;
  864. end;
  865. repeat
  866. condition:=left.getcopy;
  867. code:=right.getcopy;
  868. change:=condition.track_state_pass(exec_known);
  869. factval:=aktstate.find_fact(left);
  870. if factval<>nil then
  871. begin
  872. condition.destroy;
  873. condition:=factval.getcopy;
  874. change:=true;
  875. end;
  876. if change then
  877. begin
  878. track_state_pass:=true;
  879. {Force new resultdef pass.}
  880. condition.resultdef:=nil;
  881. do_typecheckpass(condition);
  882. end;
  883. if is_constboolnode(condition) then
  884. begin
  885. {Try to turn a while loop into a repeat loop.}
  886. if firsttest then
  887. exclude(flags,testatbegin);
  888. value:=(Tordconstnode(condition).value<>0) xor checknegate;
  889. if value then
  890. begin
  891. if code.track_state_pass(exec_known) then
  892. track_state_pass:=true;
  893. end
  894. else
  895. done:=true;
  896. end
  897. else
  898. begin
  899. {Remove any modified variables from the state.}
  900. code.track_state_pass(false);
  901. done:=true;
  902. end;
  903. code.destroy;
  904. condition.destroy;
  905. firsttest:=false;
  906. until done;
  907. {The loop condition is also known, for example:
  908. while i<10 do
  909. begin
  910. ...
  911. end;
  912. When the loop is done, we do know that i<10 = false.
  913. }
  914. condition:=left.getcopy;
  915. if condition.track_state_pass(exec_known) then
  916. begin
  917. track_state_pass:=true;
  918. {Force new resultdef pass.}
  919. condition.resultdef:=nil;
  920. do_typecheckpass(condition);
  921. end;
  922. if not is_constboolnode(condition) then
  923. aktstate.store_fact(condition,
  924. cordconstnode.create(byte(checknegate),booltype,true))
  925. else
  926. condition.destroy;
  927. end;
  928. {$endif}
  929. {*****************************************************************************
  930. TIFNODE
  931. *****************************************************************************}
  932. constructor tifnode.create(l,r,_t1 : tnode);
  933. begin
  934. inherited create(ifn,l,r,_t1,nil);
  935. end;
  936. function tifnode.internalsimplify(warn: boolean) : tnode;
  937. begin
  938. result:=nil;
  939. { optimize constant expressions }
  940. if (left.nodetype=ordconstn) then
  941. begin
  942. if tordconstnode(left).value.uvalue=1 then
  943. begin
  944. if assigned(right) then
  945. result:=right
  946. else
  947. result:=cnothingnode.create;
  948. right:=nil;
  949. if warn and assigned(t1) then
  950. CGMessagePos(t1.fileinfo,cg_w_unreachable_code);
  951. end
  952. else
  953. begin
  954. if assigned(t1) then
  955. result:=t1
  956. else
  957. result:=cnothingnode.create;
  958. t1:=nil;
  959. if warn and assigned(right) then
  960. CGMessagePos(right.fileinfo,cg_w_unreachable_code);
  961. end;
  962. end;
  963. end;
  964. function tifnode.simplify : tnode;
  965. begin
  966. result:=internalsimplify(false);
  967. end;
  968. function tifnode.pass_typecheck:tnode;
  969. begin
  970. result:=nil;
  971. resultdef:=voidtype;
  972. typecheckpass(left);
  973. { tp procvar support }
  974. maybe_call_procvar(left,true);
  975. { if path }
  976. if assigned(right) then
  977. typecheckpass(right);
  978. { else path }
  979. if assigned(t1) then
  980. typecheckpass(t1);
  981. set_varstate(left,vs_read,[vsf_must_be_valid]);
  982. if codegenerror then
  983. exit;
  984. if not is_boolean(left.resultdef) then
  985. begin
  986. if left.resultdef.typ=variantdef then
  987. inserttypeconv(left,booltype)
  988. else
  989. Message1(type_e_boolean_expr_expected,left.resultdef.typename);
  990. end;
  991. result:=internalsimplify(true);
  992. end;
  993. function tifnode.pass_1 : tnode;
  994. begin
  995. result:=nil;
  996. expectloc:=LOC_VOID;
  997. firstpass(left);
  998. { if path }
  999. if assigned(right) then
  1000. firstpass(right);
  1001. { else path }
  1002. if assigned(t1) then
  1003. firstpass(t1);
  1004. { leave if we've got an error in one of the paths }
  1005. if codegenerror then
  1006. exit;
  1007. end;
  1008. {*****************************************************************************
  1009. TFORNODE
  1010. *****************************************************************************}
  1011. constructor tfornode.create(l,r,_t1,_t2 : tnode;back : boolean);
  1012. begin
  1013. inherited create(forn,l,r,_t1,_t2);
  1014. if back then
  1015. include(loopflags,lnf_backward);
  1016. include(loopflags,lnf_testatbegin);
  1017. end;
  1018. procedure Tfornode.loop_var_access(not_type:Tnotification_flag;
  1019. symbol:Tsym);
  1020. begin
  1021. {If there is a read access, the value of the loop counter is important;
  1022. at the end of the loop the loop variable should contain the value it
  1023. had in the last iteration.}
  1024. if not_type=vn_onwrite then
  1025. begin
  1026. writeln('Loopvar does not matter on exit');
  1027. end
  1028. else
  1029. begin
  1030. exclude(loopflags,lnf_dont_mind_loopvar_on_exit);
  1031. writeln('Loopvar does matter on exit');
  1032. end;
  1033. Tabstractvarsym(symbol).unregister_notification(loopvar_notid);
  1034. end;
  1035. function tfornode.simplify : tnode;
  1036. begin
  1037. result:=nil;
  1038. if (t1.nodetype=ordconstn) and
  1039. (right.nodetype=ordconstn) and
  1040. (
  1041. (
  1042. (lnf_backward in loopflags) and
  1043. (tordconstnode(right).value<tordconstnode(t1).value)
  1044. ) or
  1045. (
  1046. not(lnf_backward in loopflags) and
  1047. (tordconstnode(right).value>tordconstnode(t1).value)
  1048. )
  1049. ) then
  1050. result:=cnothingnode.create;
  1051. end;
  1052. function tfornode.pass_typecheck:tnode;
  1053. var
  1054. res : tnode;
  1055. begin
  1056. result:=nil;
  1057. resultdef:=voidtype;
  1058. { process the loopvar, from and to, varstates are already set }
  1059. typecheckpass(left);
  1060. typecheckpass(right);
  1061. typecheckpass(t1);
  1062. set_varstate(left,vs_written,[]);
  1063. { loop unrolling }
  1064. if cs_opt_loopunroll in current_settings.optimizerswitches then
  1065. begin
  1066. res:=unroll_loop(self);
  1067. if assigned(res) then
  1068. begin
  1069. typecheckpass(res);
  1070. result:=res;
  1071. exit;
  1072. end;
  1073. end;
  1074. { Can we spare the first comparision? }
  1075. if (t1.nodetype=ordconstn) and
  1076. (right.nodetype=ordconstn) and
  1077. (
  1078. (
  1079. (lnf_backward in loopflags) and
  1080. (Tordconstnode(right).value>=Tordconstnode(t1).value)
  1081. ) or
  1082. (
  1083. not(lnf_backward in loopflags) and
  1084. (Tordconstnode(right).value<=Tordconstnode(t1).value)
  1085. )
  1086. ) then
  1087. exclude(loopflags,lnf_testatbegin);
  1088. { Make sure that the loop var and the
  1089. from and to values are compatible types }
  1090. check_ranges(right.fileinfo,right,left.resultdef);
  1091. inserttypeconv(right,left.resultdef);
  1092. check_ranges(t1.fileinfo,t1,left.resultdef);
  1093. inserttypeconv(t1,left.resultdef);
  1094. if assigned(t2) then
  1095. typecheckpass(t2);
  1096. end;
  1097. function tfornode.pass_1 : tnode;
  1098. begin
  1099. result:=nil;
  1100. expectloc:=LOC_VOID;
  1101. firstpass(left);
  1102. firstpass(right);
  1103. firstpass(t1);
  1104. if assigned(t2) then
  1105. begin
  1106. firstpass(t2);
  1107. if codegenerror then
  1108. exit;
  1109. end;
  1110. end;
  1111. {*****************************************************************************
  1112. TEXITNODE
  1113. *****************************************************************************}
  1114. constructor texitnode.create(l:tnode);
  1115. begin
  1116. inherited create(exitn,l);
  1117. end;
  1118. constructor texitnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  1119. begin
  1120. inherited ppuload(t,ppufile);
  1121. end;
  1122. procedure texitnode.ppuwrite(ppufile:tcompilerppufile);
  1123. begin
  1124. inherited ppuwrite(ppufile);
  1125. end;
  1126. function texitnode.pass_typecheck:tnode;
  1127. begin
  1128. result:=nil;
  1129. if assigned(left) then
  1130. begin
  1131. { add assignment to funcretsym }
  1132. inserttypeconv(left,current_procinfo.procdef.returndef);
  1133. left:=cassignmentnode.create(
  1134. cloadnode.create(current_procinfo.procdef.funcretsym,current_procinfo.procdef.funcretsym.owner),
  1135. left);
  1136. typecheckpass(left);
  1137. set_varstate(left,vs_read,[vsf_must_be_valid]);
  1138. end;
  1139. resultdef:=voidtype;
  1140. end;
  1141. function texitnode.pass_1 : tnode;
  1142. begin
  1143. result:=nil;
  1144. expectloc:=LOC_VOID;
  1145. if assigned(left) then
  1146. begin
  1147. firstpass(left);
  1148. if codegenerror then
  1149. exit;
  1150. end;
  1151. end;
  1152. {*****************************************************************************
  1153. TBREAKNODE
  1154. *****************************************************************************}
  1155. constructor tbreaknode.create;
  1156. begin
  1157. inherited create(breakn);
  1158. end;
  1159. function tbreaknode.pass_typecheck:tnode;
  1160. begin
  1161. result:=nil;
  1162. resultdef:=voidtype;
  1163. end;
  1164. function tbreaknode.pass_1 : tnode;
  1165. begin
  1166. result:=nil;
  1167. expectloc:=LOC_VOID;
  1168. end;
  1169. {*****************************************************************************
  1170. TCONTINUENODE
  1171. *****************************************************************************}
  1172. constructor tcontinuenode.create;
  1173. begin
  1174. inherited create(continuen);
  1175. end;
  1176. function tcontinuenode.pass_typecheck:tnode;
  1177. begin
  1178. result:=nil;
  1179. resultdef:=voidtype;
  1180. end;
  1181. function tcontinuenode.pass_1 : tnode;
  1182. begin
  1183. result:=nil;
  1184. expectloc:=LOC_VOID;
  1185. end;
  1186. {*****************************************************************************
  1187. TGOTONODE
  1188. *****************************************************************************}
  1189. constructor tgotonode.create(p : tlabelsym);
  1190. begin
  1191. inherited create(goton);
  1192. exceptionblock:=current_exceptblock;
  1193. labelnode:=nil;
  1194. labelsym:=p;
  1195. end;
  1196. constructor tgotonode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  1197. begin
  1198. inherited ppuload(t,ppufile);
  1199. labelnodeidx:=ppufile.getlongint;
  1200. exceptionblock:=ppufile.getbyte;
  1201. end;
  1202. procedure tgotonode.ppuwrite(ppufile:tcompilerppufile);
  1203. begin
  1204. inherited ppuwrite(ppufile);
  1205. labelnodeidx:=labelnode.ppuidx;
  1206. ppufile.putlongint(labelnodeidx);
  1207. ppufile.putbyte(exceptionblock);
  1208. end;
  1209. procedure tgotonode.buildderefimpl;
  1210. begin
  1211. inherited buildderefimpl;
  1212. end;
  1213. procedure tgotonode.derefimpl;
  1214. begin
  1215. inherited derefimpl;
  1216. end;
  1217. procedure tgotonode.resolveppuidx;
  1218. begin
  1219. labelnode:=tlabelnode(nodeppuidxget(labelnodeidx));
  1220. if labelnode.nodetype<>labeln then
  1221. internalerror(200809021);
  1222. end;
  1223. function tgotonode.pass_typecheck:tnode;
  1224. begin
  1225. result:=nil;
  1226. resultdef:=voidtype;
  1227. end;
  1228. function tgotonode.pass_1 : tnode;
  1229. begin
  1230. result:=nil;
  1231. expectloc:=LOC_VOID;
  1232. include(current_procinfo.flags,pi_has_goto);
  1233. { The labelnode can already be set when
  1234. this node was copied }
  1235. if not assigned(labelnode) then
  1236. begin
  1237. if assigned(labelsym.code) then
  1238. labelnode:=tlabelnode(labelsym.code)
  1239. else
  1240. CGMessage1(cg_e_goto_label_not_found,labelsym.realname);
  1241. end;
  1242. { check if we don't mess with exception blocks }
  1243. if assigned(labelnode) and
  1244. (exceptionblock<>labelnode.exceptionblock) then
  1245. CGMessage(cg_e_goto_inout_of_exception_block);
  1246. end;
  1247. function tgotonode.dogetcopy : tnode;
  1248. var
  1249. p : tgotonode;
  1250. begin
  1251. p:=tgotonode(inherited dogetcopy);
  1252. p.exceptionblock:=exceptionblock;
  1253. { generate labelnode if not done yet }
  1254. if not(assigned(labelnode)) then
  1255. begin
  1256. if assigned(labelsym) and assigned(labelsym.code) then
  1257. labelnode:=tlabelnode(labelsym.code)
  1258. end;
  1259. p.labelsym:=labelsym;
  1260. if assigned(labelnode) then
  1261. p.labelnode:=tlabelnode(labelnode.dogetcopy)
  1262. else
  1263. begin
  1264. { don't trigger IE when there was already an error, i.e. the
  1265. label is not defined. See tw11763 (PFV) }
  1266. if errorcount=0 then
  1267. internalerror(200610291);
  1268. end;
  1269. result:=p;
  1270. end;
  1271. function tgotonode.docompare(p: tnode): boolean;
  1272. begin
  1273. docompare := false;
  1274. end;
  1275. {*****************************************************************************
  1276. TLABELNODE
  1277. *****************************************************************************}
  1278. constructor tlabelnode.create(l:tnode;alabsym:tlabelsym);
  1279. begin
  1280. inherited create(labeln,l);
  1281. exceptionblock:=current_exceptblock;
  1282. labsym:=alabsym;
  1283. { Register labelnode in labelsym }
  1284. labsym.code:=self;
  1285. end;
  1286. constructor tlabelnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  1287. begin
  1288. inherited ppuload(t,ppufile);
  1289. exceptionblock:=ppufile.getbyte;
  1290. end;
  1291. destructor tlabelnode.destroy;
  1292. begin
  1293. { Remove reference in labelsym, this is to prevent
  1294. goto's to this label }
  1295. if assigned(labsym) and (labsym.code=pointer(self)) then
  1296. labsym.code:=nil;
  1297. inherited destroy;
  1298. end;
  1299. procedure tlabelnode.ppuwrite(ppufile:tcompilerppufile);
  1300. begin
  1301. inherited ppuwrite(ppufile);
  1302. ppufile.putbyte(exceptionblock);
  1303. end;
  1304. procedure tlabelnode.buildderefimpl;
  1305. begin
  1306. inherited buildderefimpl;
  1307. end;
  1308. procedure tlabelnode.derefimpl;
  1309. begin
  1310. inherited derefimpl;
  1311. end;
  1312. function tlabelnode.pass_typecheck:tnode;
  1313. begin
  1314. result:=nil;
  1315. { left could still be unassigned }
  1316. if assigned(left) then
  1317. typecheckpass(left);
  1318. resultdef:=voidtype;
  1319. end;
  1320. function tlabelnode.pass_1 : tnode;
  1321. begin
  1322. result:=nil;
  1323. expectloc:=LOC_VOID;
  1324. if assigned(left) then
  1325. firstpass(left);
  1326. end;
  1327. function tlabelnode.dogetcopy : tnode;
  1328. begin
  1329. if not(assigned(copiedto)) then
  1330. copiedto:=tlabelnode(inherited dogetcopy);
  1331. copiedto.exceptionblock:=exceptionblock;
  1332. result:=copiedto;
  1333. end;
  1334. function tlabelnode.docompare(p: tnode): boolean;
  1335. begin
  1336. docompare := false;
  1337. end;
  1338. {*****************************************************************************
  1339. TRAISENODE
  1340. *****************************************************************************}
  1341. constructor traisenode.create(l,taddr,tframe:tnode);
  1342. begin
  1343. inherited create(raisen,l,taddr,tframe);
  1344. end;
  1345. function traisenode.pass_typecheck:tnode;
  1346. begin
  1347. result:=nil;
  1348. resultdef:=voidtype;
  1349. if assigned(left) then
  1350. begin
  1351. { first para must be a _class_ }
  1352. typecheckpass(left);
  1353. set_varstate(left,vs_read,[vsf_must_be_valid]);
  1354. if codegenerror then
  1355. exit;
  1356. if not(is_class(left.resultdef)) then
  1357. CGMessage1(type_e_class_type_expected,left.resultdef.typename);
  1358. { insert needed typeconvs for addr,frame }
  1359. if assigned(right) then
  1360. begin
  1361. { addr }
  1362. typecheckpass(right);
  1363. inserttypeconv(right,voidpointertype);
  1364. { frame }
  1365. if assigned(third) then
  1366. begin
  1367. typecheckpass(third);
  1368. inserttypeconv(third,voidpointertype);
  1369. end;
  1370. end;
  1371. end;
  1372. end;
  1373. function traisenode.pass_1 : tnode;
  1374. begin
  1375. result:=nil;
  1376. include(current_procinfo.flags,pi_do_call);
  1377. expectloc:=LOC_VOID;
  1378. if assigned(left) then
  1379. begin
  1380. { first para must be a _class_ }
  1381. firstpass(left);
  1382. { insert needed typeconvs for addr,frame }
  1383. if assigned(right) then
  1384. begin
  1385. { addr }
  1386. firstpass(right);
  1387. { frame }
  1388. if assigned(third) then
  1389. firstpass(third);
  1390. end;
  1391. end;
  1392. end;
  1393. {*****************************************************************************
  1394. TTRYEXCEPTNODE
  1395. *****************************************************************************}
  1396. constructor ttryexceptnode.create(l,r,_t1 : tnode);
  1397. begin
  1398. inherited create(tryexceptn,l,r,_t1,nil);
  1399. end;
  1400. function ttryexceptnode.pass_typecheck:tnode;
  1401. begin
  1402. result:=nil;
  1403. typecheckpass(left);
  1404. { on statements }
  1405. if assigned(right) then
  1406. typecheckpass(right);
  1407. { else block }
  1408. if assigned(t1) then
  1409. typecheckpass(t1);
  1410. resultdef:=voidtype;
  1411. end;
  1412. function ttryexceptnode.pass_1 : tnode;
  1413. begin
  1414. result:=nil;
  1415. include(current_procinfo.flags,pi_do_call);
  1416. expectloc:=LOC_VOID;
  1417. firstpass(left);
  1418. { on statements }
  1419. if assigned(right) then
  1420. firstpass(right);
  1421. { else block }
  1422. if assigned(t1) then
  1423. firstpass(t1);
  1424. end;
  1425. {*****************************************************************************
  1426. TTRYFINALLYNODE
  1427. *****************************************************************************}
  1428. constructor ttryfinallynode.create(l,r:tnode);
  1429. begin
  1430. inherited create(tryfinallyn,l,r,nil,nil);
  1431. implicitframe:=false;
  1432. end;
  1433. constructor ttryfinallynode.create_implicit(l,r,_t1:tnode);
  1434. begin
  1435. inherited create(tryfinallyn,l,r,_t1,nil);
  1436. implicitframe:=true;
  1437. end;
  1438. function ttryfinallynode.pass_typecheck:tnode;
  1439. begin
  1440. result:=nil;
  1441. include(current_procinfo.flags,pi_do_call);
  1442. resultdef:=voidtype;
  1443. typecheckpass(left);
  1444. // "try block" is "used"? (JM)
  1445. set_varstate(left,vs_readwritten,[vsf_must_be_valid]);
  1446. typecheckpass(right);
  1447. // "except block" is "used"? (JM)
  1448. set_varstate(right,vs_readwritten,[vsf_must_be_valid]);
  1449. { special finally block only executed when there was an exception }
  1450. if assigned(t1) then
  1451. begin
  1452. typecheckpass(t1);
  1453. // "finally block" is "used"? (JM)
  1454. set_varstate(t1,vs_readwritten,[vsf_must_be_valid]);
  1455. end;
  1456. end;
  1457. function ttryfinallynode.pass_1 : tnode;
  1458. begin
  1459. result:=nil;
  1460. expectloc:=LOC_VOID;
  1461. firstpass(left);
  1462. firstpass(right);
  1463. if assigned(t1) then
  1464. firstpass(t1);
  1465. end;
  1466. function ttryfinallynode.simplify: tnode;
  1467. begin
  1468. result:=nil;
  1469. { if the try contains no code, we can kill
  1470. the try and except and return only the
  1471. finally part }
  1472. if has_no_code(left) then
  1473. begin
  1474. result:=right;
  1475. right:=nil;
  1476. end;
  1477. end;
  1478. {*****************************************************************************
  1479. TONNODE
  1480. *****************************************************************************}
  1481. constructor tonnode.create(l,r:tnode);
  1482. begin
  1483. inherited create(onn,l,r);
  1484. excepTSymtable:=nil;
  1485. excepttype:=nil;
  1486. end;
  1487. destructor tonnode.destroy;
  1488. begin
  1489. { copied nodes don't need to release the symtable }
  1490. if assigned(excepTSymtable) then
  1491. excepTSymtable.free;
  1492. inherited destroy;
  1493. end;
  1494. constructor tonnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  1495. begin
  1496. inherited ppuload(t,ppufile);
  1497. excepTSymtable:=nil;
  1498. excepttype:=nil;
  1499. end;
  1500. function tonnode.dogetcopy : tnode;
  1501. var
  1502. n : tonnode;
  1503. begin
  1504. n:=tonnode(inherited dogetcopy);
  1505. if assigned(exceptsymtable) then
  1506. n.exceptsymtable:=exceptsymtable.getcopy
  1507. else
  1508. n.exceptsymtable:=nil;
  1509. n.excepttype:=excepttype;
  1510. result:=n;
  1511. end;
  1512. function tonnode.pass_typecheck:tnode;
  1513. begin
  1514. result:=nil;
  1515. resultdef:=voidtype;
  1516. if not(is_class(excepttype)) then
  1517. CGMessage1(type_e_class_type_expected,excepttype.typename);
  1518. if assigned(left) then
  1519. typecheckpass(left);
  1520. if assigned(right) then
  1521. typecheckpass(right);
  1522. end;
  1523. function tonnode.pass_1 : tnode;
  1524. begin
  1525. result:=nil;
  1526. include(current_procinfo.flags,pi_do_call);
  1527. expectloc:=LOC_VOID;
  1528. if assigned(left) then
  1529. firstpass(left);
  1530. if assigned(right) then
  1531. firstpass(right);
  1532. end;
  1533. function tonnode.docompare(p: tnode): boolean;
  1534. begin
  1535. docompare := false;
  1536. end;
  1537. begin
  1538. cwhilerepeatnode:=twhilerepeatnode;
  1539. cifnode:=tifnode;
  1540. cfornode:=tfornode;
  1541. cexitnode:=texitnode;
  1542. cgotonode:=tgotonode;
  1543. clabelnode:=tlabelnode;
  1544. craisenode:=traisenode;
  1545. ctryexceptnode:=ttryexceptnode;
  1546. ctryfinallynode:=ttryfinallynode;
  1547. connode:=tonnode;
  1548. end.