nflw.pas 53 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796
  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: tnode;
  265. is_string: boolean;
  266. begin
  267. { result is a block of statements }
  268. result:=internalstatements(loopstatement);
  269. is_string := ado_IsConstString in tarraydef(expr.resultdef).arrayoptions;
  270. if (node_complexity(expr) > 1) and not is_open_array(expr.resultdef) then
  271. begin
  272. { create a temp variable for expression }
  273. arrayvar := ctempcreatenode.create(
  274. expr.resultdef,
  275. expr.resultdef.size,
  276. tt_persistent,true);
  277. if is_string then
  278. begin
  279. lowbound:=genintconstnode(1);
  280. highbound:=cinlinenode.create(in_length_x,false,ctemprefnode.create(arrayvar))
  281. end
  282. else
  283. begin
  284. lowbound:=cinlinenode.create(in_low_x,false,ctemprefnode.create(arrayvar));
  285. highbound:=cinlinenode.create(in_high_x,false,ctemprefnode.create(arrayvar));
  286. end;
  287. addstatement(loopstatement,arrayvar);
  288. addstatement(loopstatement,cassignmentnode.create(ctemprefnode.create(arrayvar),expr.getcopy));
  289. end
  290. else
  291. begin
  292. arrayvar:=nil;
  293. if is_string then
  294. begin
  295. lowbound:=genintconstnode(1);
  296. highbound:=cinlinenode.create(in_length_x,false,expr.getcopy);
  297. end
  298. else
  299. begin
  300. lowbound:=cinlinenode.create(in_low_x,false,expr.getcopy);
  301. highbound:=cinlinenode.create(in_high_x,false,expr.getcopy);
  302. end;
  303. end;
  304. { create a loop counter }
  305. loopvar := ctempcreatenode.create(
  306. tarraydef(expr.resultdef).rangedef,
  307. tarraydef(expr.resultdef).rangedef.size,
  308. tt_persistent,true);
  309. addstatement(loopstatement,loopvar);
  310. arrayindex:=ctemprefnode.create(loopvar);
  311. loopbody:=internalstatements(loopbodystatement);
  312. // for-in loop variable := array_expression[index]
  313. if assigned(arrayvar) then
  314. addstatement(loopbodystatement,
  315. cassignmentnode.create(hloopvar,cvecnode.create(ctemprefnode.create(arrayvar),arrayindex)))
  316. else
  317. addstatement(loopbodystatement,
  318. cassignmentnode.create(hloopvar,cvecnode.create(expr.getcopy,arrayindex)));
  319. { add the actual statement to the loop }
  320. addstatement(loopbodystatement,hloopbody);
  321. forloopnode:=cfornode.create(ctemprefnode.create(loopvar),
  322. lowbound,
  323. highbound,
  324. loopbody,
  325. false);
  326. addstatement(loopstatement,forloopnode);
  327. { free the loop counter }
  328. addstatement(loopstatement,ctempdeletenode.create(loopvar));
  329. { free the temp variable for expression if needed }
  330. if arrayvar<>nil then
  331. addstatement(loopstatement,ctempdeletenode.create(arrayvar));
  332. end;
  333. function create_set_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  334. var
  335. loopstatement, loopbodystatement: tstatementnode;
  336. loopvar, setvar: ttempcreatenode;
  337. loopbody, forloopnode: tnode;
  338. begin
  339. // first check is set is empty and if it so then skip other processing
  340. if not Assigned(tsetdef(expr.resultdef).elementdef) then
  341. begin
  342. result:=cnothingnode.create;
  343. // free unused nodes
  344. hloopvar.free;
  345. hloopbody.free;
  346. exit;
  347. end;
  348. { result is a block of statements }
  349. result:=internalstatements(loopstatement);
  350. { create a temp variable for expression }
  351. setvar := ctempcreatenode.create(
  352. expr.resultdef,
  353. expr.resultdef.size,
  354. tt_persistent,true);
  355. addstatement(loopstatement,setvar);
  356. addstatement(loopstatement,cassignmentnode.create(ctemprefnode.create(setvar),expr.getcopy));
  357. { create a loop counter }
  358. loopvar := ctempcreatenode.create(
  359. tsetdef(expr.resultdef).elementdef,
  360. tsetdef(expr.resultdef).elementdef.size,
  361. tt_persistent,true);
  362. addstatement(loopstatement,loopvar);
  363. // if loopvar in set then
  364. // begin
  365. // hloopvar := loopvar
  366. // for-in loop body
  367. // end
  368. loopbody:=cifnode.create(
  369. cinnode.create(ctemprefnode.create(loopvar),ctemprefnode.create(setvar)),
  370. internalstatements(loopbodystatement),
  371. nil
  372. );
  373. addstatement(loopbodystatement,cassignmentnode.create(hloopvar,ctemprefnode.create(loopvar)));
  374. { add the actual statement to the loop }
  375. addstatement(loopbodystatement,hloopbody);
  376. forloopnode:=cfornode.create(ctemprefnode.create(loopvar),
  377. cinlinenode.create(in_low_x,false,ctemprefnode.create(setvar)),
  378. cinlinenode.create(in_high_x,false,ctemprefnode.create(setvar)),
  379. loopbody,
  380. false);
  381. addstatement(loopstatement,forloopnode);
  382. { free the loop counter }
  383. addstatement(loopstatement,ctempdeletenode.create(loopvar));
  384. { free the temp variable for expression }
  385. addstatement(loopstatement,ctempdeletenode.create(setvar));
  386. end;
  387. function create_enumerator_for_in_loop(hloopvar, hloopbody, expr: tnode;
  388. enumerator_get, enumerator_move: tprocdef; enumerator_current: tpropertysym): tnode;
  389. var
  390. loopstatement, loopbodystatement: tstatementnode;
  391. enumvar: ttempcreatenode;
  392. loopbody, whileloopnode,
  393. enum_get, enum_move, enum_current, enum_get_params: tnode;
  394. propaccesslist: tpropaccesslist;
  395. enumerator_is_class: boolean;
  396. enumerator_destructor: tprocdef;
  397. begin
  398. { result is a block of statements }
  399. result:=internalstatements(loopstatement);
  400. enumerator_is_class := is_class(enumerator_get.returndef);
  401. { create a temp variable for enumerator }
  402. enumvar := ctempcreatenode.create(
  403. enumerator_get.returndef,
  404. enumerator_get.returndef.size,
  405. tt_persistent,true);
  406. addstatement(loopstatement,enumvar);
  407. if enumerator_get.proctypeoption=potype_operator then
  408. begin
  409. enum_get_params:=ccallparanode.create(expr.getcopy,nil);
  410. enum_get:=ccallnode.create(enum_get_params, tprocsym(enumerator_get.procsym), nil, nil, []);
  411. tcallnode(enum_get).procdefinition:=enumerator_get;
  412. addsymref(enumerator_get.procsym);
  413. end
  414. else
  415. enum_get:=ccallnode.create(nil, tprocsym(enumerator_get.procsym), enumerator_get.owner, expr.getcopy, []);
  416. addstatement(loopstatement,
  417. cassignmentnode.create(
  418. ctemprefnode.create(enumvar),
  419. enum_get
  420. ));
  421. loopbody:=internalstatements(loopbodystatement);
  422. { for-in loop variable := enumerator.current }
  423. if getpropaccesslist(enumerator_current,palt_read,propaccesslist) then
  424. begin
  425. case propaccesslist.firstsym^.sym.typ of
  426. fieldvarsym :
  427. begin
  428. { generate access code }
  429. enum_current:=ctemprefnode.create(enumvar);
  430. propaccesslist_to_node(enum_current,enumerator_current.owner,propaccesslist);
  431. include(enum_current.flags,nf_isproperty);
  432. end;
  433. procsym :
  434. begin
  435. { generate the method call }
  436. enum_current:=ccallnode.create(nil,tprocsym(propaccesslist.firstsym^.sym),enumerator_current.owner,ctemprefnode.create(enumvar),[]);
  437. include(enum_current.flags,nf_isproperty);
  438. end
  439. else
  440. begin
  441. enum_current:=cerrornode.create;
  442. Message(type_e_mismatch);
  443. end;
  444. end;
  445. end
  446. else
  447. enum_current:=cerrornode.create;
  448. addstatement(loopbodystatement,
  449. cassignmentnode.create(hloopvar, enum_current));
  450. { add the actual statement to the loop }
  451. addstatement(loopbodystatement,hloopbody);
  452. enum_move:=ccallnode.create(nil, tprocsym(enumerator_move.procsym), enumerator_move.owner, ctemprefnode.create(enumvar), []);
  453. whileloopnode:=cwhilerepeatnode.create(enum_move,loopbody,true,false);
  454. if enumerator_is_class then
  455. begin
  456. { insert a try-finally and call the destructor for the enumerator in the finally section }
  457. enumerator_destructor:=tobjectdef(enumerator_get.returndef).Finddestructor;
  458. if assigned(enumerator_destructor) then
  459. begin
  460. whileloopnode:=ctryfinallynode.create(
  461. whileloopnode, // try node
  462. ccallnode.create(nil,tprocsym(enumerator_destructor.procsym), // finally node
  463. enumerator_destructor.procsym.owner,ctemprefnode.create(enumvar),[]));
  464. end;
  465. { if getenumerator <> nil then do the loop }
  466. whileloopnode:=cifnode.create(
  467. caddnode.create(unequaln, ctemprefnode.create(enumvar), cnilnode.create),
  468. whileloopnode,
  469. nil
  470. );
  471. end;
  472. addstatement(loopstatement, whileloopnode);
  473. if is_object(enumerator_get.returndef) then
  474. begin
  475. // call the object destructor too
  476. enumerator_destructor:=tobjectdef(enumerator_get.returndef).Finddestructor;
  477. if assigned(enumerator_destructor) then
  478. begin
  479. addstatement(loopstatement,
  480. ccallnode.create(nil,tprocsym(enumerator_destructor.procsym),
  481. enumerator_destructor.procsym.owner,ctemprefnode.create(enumvar),[]));
  482. end;
  483. end;
  484. { free the temp variable for enumerator }
  485. addstatement(loopstatement,ctempdeletenode.create(enumvar));
  486. end;
  487. function create_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  488. var
  489. pd, movenext: tprocdef;
  490. current: tpropertysym;
  491. begin
  492. if expr.nodetype=typen then
  493. result:=create_type_for_in_loop(hloopvar, hloopbody, expr)
  494. else
  495. begin
  496. { loop is made for an expression }
  497. // search for operator first
  498. pd:=search_enumerator_operator(expr.resultdef);
  499. // if there is no operator then search for class/object enumerator method
  500. if (pd=nil) and (expr.resultdef.typ=objectdef) then
  501. pd:=tobjectdef(expr.resultdef).search_enumerator_get;
  502. if pd<>nil then
  503. begin
  504. // seach movenext and current symbols
  505. movenext:=tobjectdef(pd.returndef).search_enumerator_move;
  506. if movenext = nil then
  507. begin
  508. result:=cerrornode.create;
  509. hloopvar.free;
  510. hloopbody.free;
  511. Message1(sym_e_no_enumerator_move,pd.returndef.GetTypeName);
  512. end
  513. else
  514. begin
  515. current:=tpropertysym(tobjectdef(pd.returndef).search_enumerator_current);
  516. if current = nil then
  517. begin
  518. result:=cerrornode.create;
  519. hloopvar.free;
  520. hloopbody.free;
  521. Message1(sym_e_no_enumerator_current,pd.returndef.GetTypeName);
  522. end
  523. else
  524. result:=create_enumerator_for_in_loop(hloopvar, hloopbody, expr, pd, movenext, current);
  525. end;
  526. end
  527. else
  528. begin
  529. case expr.resultdef.typ of
  530. stringdef: result:=create_string_for_in_loop(hloopvar, hloopbody, expr);
  531. arraydef: result:=create_array_for_in_loop(hloopvar, hloopbody, expr);
  532. setdef: result:=create_set_for_in_loop(hloopvar, hloopbody, expr);
  533. else
  534. begin
  535. result:=cerrornode.create;
  536. hloopvar.free;
  537. hloopbody.free;
  538. Message1(sym_e_no_enumerator,expr.resultdef.GetTypeName);
  539. end;
  540. end;
  541. end;
  542. end;
  543. end;
  544. {****************************************************************************
  545. TLOOPNODE
  546. *****************************************************************************}
  547. constructor tloopnode.create(tt : tnodetype;l,r,_t1,_t2 : tnode);
  548. begin
  549. inherited create(tt,l,r);
  550. t1:=_t1;
  551. t2:=_t2;
  552. fileinfo:=l.fileinfo;
  553. end;
  554. destructor tloopnode.destroy;
  555. begin
  556. t1.free;
  557. t2.free;
  558. inherited destroy;
  559. end;
  560. constructor tloopnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  561. begin
  562. inherited ppuload(t,ppufile);
  563. t1:=ppuloadnode(ppufile);
  564. t2:=ppuloadnode(ppufile);
  565. end;
  566. procedure tloopnode.ppuwrite(ppufile:tcompilerppufile);
  567. begin
  568. inherited ppuwrite(ppufile);
  569. ppuwritenode(ppufile,t1);
  570. ppuwritenode(ppufile,t2);
  571. end;
  572. procedure tloopnode.buildderefimpl;
  573. begin
  574. inherited buildderefimpl;
  575. if assigned(t1) then
  576. t1.buildderefimpl;
  577. if assigned(t2) then
  578. t2.buildderefimpl;
  579. end;
  580. procedure tloopnode.derefimpl;
  581. begin
  582. inherited derefimpl;
  583. if assigned(t1) then
  584. t1.derefimpl;
  585. if assigned(t2) then
  586. t2.derefimpl;
  587. end;
  588. function tloopnode.dogetcopy : tnode;
  589. var
  590. p : tloopnode;
  591. begin
  592. p:=tloopnode(inherited dogetcopy);
  593. if assigned(t1) then
  594. p.t1:=t1.dogetcopy
  595. else
  596. p.t1:=nil;
  597. if assigned(t2) then
  598. p.t2:=t2.dogetcopy
  599. else
  600. p.t2:=nil;
  601. p.loopflags:=loopflags;
  602. dogetcopy:=p;
  603. end;
  604. procedure tloopnode.insertintolist(l : tnodelist);
  605. begin
  606. end;
  607. procedure tloopnode.printnodetree(var t:text);
  608. begin
  609. write(t,printnodeindention,'(');
  610. printnodeindent;
  611. printnodeinfo(t);
  612. writeln(t);
  613. printnode(t,left);
  614. printnode(t,right);
  615. printnode(t,t1);
  616. printnode(t,t2);
  617. printnodeunindent;
  618. writeln(t,printnodeindention,')');
  619. end;
  620. function tloopnode.docompare(p: tnode): boolean;
  621. begin
  622. docompare :=
  623. inherited docompare(p) and
  624. (loopflags*loopflagsequal=tloopnode(p).loopflags*loopflagsequal) and
  625. t1.isequal(tloopnode(p).t1) and
  626. t2.isequal(tloopnode(p).t2);
  627. end;
  628. {****************************************************************************
  629. TWHILEREPEATNODE
  630. *****************************************************************************}
  631. constructor Twhilerepeatnode.create(l,r:Tnode;tab,cn:boolean);
  632. begin
  633. inherited create(whilerepeatn,l,r,nil,nil);
  634. if tab then
  635. include(loopflags, lnf_testatbegin);
  636. if cn then
  637. include(loopflags,lnf_checknegate);
  638. end;
  639. function twhilerepeatnode.pass_typecheck:tnode;
  640. var
  641. t:Tunarynode;
  642. begin
  643. result:=nil;
  644. resultdef:=voidtype;
  645. typecheckpass(left);
  646. { tp procvar support }
  647. maybe_call_procvar(left,true);
  648. {A not node can be removed.}
  649. if left.nodetype=notn then
  650. begin
  651. t:=Tunarynode(left);
  652. left:=Tunarynode(left).left;
  653. t.left:=nil;
  654. t.destroy;
  655. {Symdif operator, in case you are wondering:}
  656. loopflags:=loopflags >< [lnf_checknegate];
  657. end;
  658. { loop instruction }
  659. if assigned(right) then
  660. typecheckpass(right);
  661. set_varstate(left,vs_read,[vsf_must_be_valid]);
  662. if codegenerror then
  663. exit;
  664. if not is_boolean(left.resultdef) then
  665. begin
  666. if left.resultdef.typ=variantdef then
  667. inserttypeconv(left,booltype)
  668. else
  669. CGMessage1(type_e_boolean_expr_expected,left.resultdef.typename);
  670. end;
  671. { Give warnings for code that will never be executed for
  672. while false do }
  673. if (lnf_testatbegin in loopflags) and
  674. (left.nodetype=ordconstn) and
  675. (tordconstnode(left).value.uvalue=0) and
  676. assigned(right) then
  677. CGMessagePos(right.fileinfo,cg_w_unreachable_code);
  678. end;
  679. {$ifdef prefetchnext}
  680. type
  681. passignmentquery = ^tassignmentquery;
  682. tassignmentquery = record
  683. towhat: tnode;
  684. source: tassignmentnode;
  685. statementcount: cardinal;
  686. end;
  687. function checkassignment(var n: tnode; arg: pointer): foreachnoderesult;
  688. var
  689. query: passignmentquery absolute arg;
  690. temp, prederef: tnode;
  691. begin
  692. result := fen_norecurse_false;
  693. if (n.nodetype in [assignn,inlinen,forn,calln,whilerepeatn,casen,ifn]) then
  694. inc(query^.statementcount);
  695. { make sure there's something else in the loop besides going to the }
  696. { next item }
  697. if (query^.statementcount > 1) and
  698. (n.nodetype = assignn) then
  699. begin
  700. { skip type conversions of assignment target }
  701. temp := tassignmentnode(n).left;
  702. while (temp.nodetype = typeconvn) do
  703. temp := ttypeconvnode(temp).left;
  704. { assignment to x of the while assigned(x) check? }
  705. if not(temp.isequal(query^.towhat)) then
  706. exit;
  707. { right hand side of assignment dereferenced field of }
  708. { x? (no derefn in case of class) }
  709. temp := tassignmentnode(n).right;
  710. while (temp.nodetype = typeconvn) do
  711. temp := ttypeconvnode(temp).left;
  712. if (temp.nodetype <> subscriptn) then
  713. exit;
  714. prederef := tsubscriptnode(temp).left;
  715. temp := prederef;
  716. while (temp.nodetype = typeconvn) do
  717. temp := ttypeconvnode(temp).left;
  718. { see tests/test/prefetch1.pp }
  719. if (temp.nodetype = derefn) then
  720. temp := tderefnode(temp).left
  721. else
  722. temp := prederef;
  723. if temp.isequal(query^.towhat) then
  724. begin
  725. query^.source := tassignmentnode(n);
  726. result := fen_norecurse_true;
  727. end
  728. end
  729. { don't check nodes which can't contain an assignment or whose }
  730. { final assignment can vary a lot }
  731. else if not(n.nodetype in [calln,inlinen,casen,whilerepeatn,forn]) then
  732. result := fen_false;
  733. end;
  734. function findassignment(where: tnode; towhat: tnode): tassignmentnode;
  735. var
  736. query: tassignmentquery;
  737. begin
  738. query.towhat := towhat;
  739. query.source := nil;
  740. query.statementcount := 0;
  741. if foreachnodestatic(where,@checkassignment,@query) then
  742. result := query.source
  743. else
  744. result := nil;
  745. end;
  746. {$endif prefetchnext}
  747. function twhilerepeatnode.pass_1 : tnode;
  748. {$ifdef prefetchnext}
  749. var
  750. runnernode, prefetchcode: tnode;
  751. assignmentnode: tassignmentnode;
  752. prefetchstatements: tstatementnode;
  753. {$endif prefetchnext}
  754. begin
  755. result:=nil;
  756. expectloc:=LOC_VOID;
  757. firstpass(left);
  758. if codegenerror then
  759. exit;
  760. { loop instruction }
  761. if assigned(right) then
  762. begin
  763. firstpass(right);
  764. if codegenerror then
  765. exit;
  766. end;
  767. {$ifdef prefetchnext}
  768. { do at the end so all complex typeconversions are already }
  769. { converted to calln's }
  770. if (cs_opt_level1 in current_settings.optimizerswitches) and
  771. (lnf_testatbegin in loopflags) then
  772. begin
  773. { get first component of the while check }
  774. runnernode := left;
  775. while (runnernode.nodetype in [andn,orn,notn,xorn,typeconvn]) do
  776. runnernode := tunarynode(runnernode).left;
  777. { is it an assigned(x) check? }
  778. if ((runnernode.nodetype = inlinen) and
  779. (tinlinenode(runnernode).inlinenumber = in_assigned_x)) or
  780. ((runnernode.nodetype = unequaln) and
  781. (taddnode(runnernode).right.nodetype = niln)) then
  782. begin
  783. runnernode := tunarynode(runnernode).left;
  784. { in case of in_assigned_x, there's a callparan in between }
  785. if (runnernode.nodetype = callparan) then
  786. runnernode := tcallparanode(runnernode).left;
  787. while (runnernode.nodetype = typeconvn) do
  788. runnernode := ttypeconvnode(runnernode).left;
  789. { is there an "x := x(^).somefield"? }
  790. assignmentnode := findassignment(right,runnernode);
  791. if assigned(assignmentnode) then
  792. begin
  793. prefetchcode := internalstatements(prefetchstatements);
  794. addstatement(prefetchstatements,geninlinenode(in_prefetch_var,false,
  795. cderefnode.create(ctypeconvnode.create(assignmentnode.right.getcopy,voidpointertype))));
  796. addstatement(prefetchstatements,right);
  797. right := prefetchcode;
  798. typecheckpass(right);
  799. end;
  800. end;
  801. end;
  802. {$endif prefetchnext}
  803. end;
  804. {$ifdef state_tracking}
  805. function Twhilerepeatnode.track_state_pass(exec_known:boolean):boolean;
  806. var condition:Tnode;
  807. code:Tnode;
  808. done:boolean;
  809. value:boolean;
  810. change:boolean;
  811. firsttest:boolean;
  812. factval:Tnode;
  813. begin
  814. track_state_pass:=false;
  815. done:=false;
  816. firsttest:=true;
  817. {For repeat until statements, first do a pass through the code.}
  818. if not(lnf_testatbegin in flags) then
  819. begin
  820. code:=right.getcopy;
  821. if code.track_state_pass(exec_known) then
  822. track_state_pass:=true;
  823. code.destroy;
  824. end;
  825. repeat
  826. condition:=left.getcopy;
  827. code:=right.getcopy;
  828. change:=condition.track_state_pass(exec_known);
  829. factval:=aktstate.find_fact(left);
  830. if factval<>nil then
  831. begin
  832. condition.destroy;
  833. condition:=factval.getcopy;
  834. change:=true;
  835. end;
  836. if change then
  837. begin
  838. track_state_pass:=true;
  839. {Force new resultdef pass.}
  840. condition.resultdef:=nil;
  841. do_typecheckpass(condition);
  842. end;
  843. if is_constboolnode(condition) then
  844. begin
  845. {Try to turn a while loop into a repeat loop.}
  846. if firsttest then
  847. exclude(flags,testatbegin);
  848. value:=(Tordconstnode(condition).value<>0) xor checknegate;
  849. if value then
  850. begin
  851. if code.track_state_pass(exec_known) then
  852. track_state_pass:=true;
  853. end
  854. else
  855. done:=true;
  856. end
  857. else
  858. begin
  859. {Remove any modified variables from the state.}
  860. code.track_state_pass(false);
  861. done:=true;
  862. end;
  863. code.destroy;
  864. condition.destroy;
  865. firsttest:=false;
  866. until done;
  867. {The loop condition is also known, for example:
  868. while i<10 do
  869. begin
  870. ...
  871. end;
  872. When the loop is done, we do know that i<10 = false.
  873. }
  874. condition:=left.getcopy;
  875. if condition.track_state_pass(exec_known) then
  876. begin
  877. track_state_pass:=true;
  878. {Force new resultdef pass.}
  879. condition.resultdef:=nil;
  880. do_typecheckpass(condition);
  881. end;
  882. if not is_constboolnode(condition) then
  883. aktstate.store_fact(condition,
  884. cordconstnode.create(byte(checknegate),booltype,true))
  885. else
  886. condition.destroy;
  887. end;
  888. {$endif}
  889. {*****************************************************************************
  890. TIFNODE
  891. *****************************************************************************}
  892. constructor tifnode.create(l,r,_t1 : tnode);
  893. begin
  894. inherited create(ifn,l,r,_t1,nil);
  895. end;
  896. function tifnode.internalsimplify(warn: boolean) : tnode;
  897. begin
  898. result:=nil;
  899. { optimize constant expressions }
  900. if (left.nodetype=ordconstn) then
  901. begin
  902. if tordconstnode(left).value.uvalue=1 then
  903. begin
  904. if assigned(right) then
  905. result:=right
  906. else
  907. result:=cnothingnode.create;
  908. right:=nil;
  909. if warn and assigned(t1) then
  910. CGMessagePos(t1.fileinfo,cg_w_unreachable_code);
  911. end
  912. else
  913. begin
  914. if assigned(t1) then
  915. result:=t1
  916. else
  917. result:=cnothingnode.create;
  918. t1:=nil;
  919. if warn and assigned(right) then
  920. CGMessagePos(right.fileinfo,cg_w_unreachable_code);
  921. end;
  922. end;
  923. end;
  924. function tifnode.simplify : tnode;
  925. begin
  926. result:=internalsimplify(false);
  927. end;
  928. function tifnode.pass_typecheck:tnode;
  929. begin
  930. result:=nil;
  931. resultdef:=voidtype;
  932. typecheckpass(left);
  933. { tp procvar support }
  934. maybe_call_procvar(left,true);
  935. { if path }
  936. if assigned(right) then
  937. typecheckpass(right);
  938. { else path }
  939. if assigned(t1) then
  940. typecheckpass(t1);
  941. set_varstate(left,vs_read,[vsf_must_be_valid]);
  942. if codegenerror then
  943. exit;
  944. if not is_boolean(left.resultdef) then
  945. begin
  946. if left.resultdef.typ=variantdef then
  947. inserttypeconv(left,booltype)
  948. else
  949. Message1(type_e_boolean_expr_expected,left.resultdef.typename);
  950. end;
  951. result:=internalsimplify(true);
  952. end;
  953. function tifnode.pass_1 : tnode;
  954. begin
  955. result:=nil;
  956. expectloc:=LOC_VOID;
  957. firstpass(left);
  958. { if path }
  959. if assigned(right) then
  960. firstpass(right);
  961. { else path }
  962. if assigned(t1) then
  963. firstpass(t1);
  964. { leave if we've got an error in one of the paths }
  965. if codegenerror then
  966. exit;
  967. end;
  968. {*****************************************************************************
  969. TFORNODE
  970. *****************************************************************************}
  971. constructor tfornode.create(l,r,_t1,_t2 : tnode;back : boolean);
  972. begin
  973. inherited create(forn,l,r,_t1,_t2);
  974. if back then
  975. include(loopflags,lnf_backward);
  976. include(loopflags,lnf_testatbegin);
  977. end;
  978. procedure Tfornode.loop_var_access(not_type:Tnotification_flag;
  979. symbol:Tsym);
  980. begin
  981. {If there is a read access, the value of the loop counter is important;
  982. at the end of the loop the loop variable should contain the value it
  983. had in the last iteration.}
  984. if not_type=vn_onwrite then
  985. begin
  986. writeln('Loopvar does not matter on exit');
  987. end
  988. else
  989. begin
  990. exclude(loopflags,lnf_dont_mind_loopvar_on_exit);
  991. writeln('Loopvar does matter on exit');
  992. end;
  993. Tabstractvarsym(symbol).unregister_notification(loopvar_notid);
  994. end;
  995. function tfornode.simplify : tnode;
  996. begin
  997. result:=nil;
  998. if (t1.nodetype=ordconstn) and
  999. (right.nodetype=ordconstn) and
  1000. (
  1001. (
  1002. (lnf_backward in loopflags) and
  1003. (tordconstnode(right).value<tordconstnode(t1).value)
  1004. ) or
  1005. (
  1006. not(lnf_backward in loopflags) and
  1007. (tordconstnode(right).value>tordconstnode(t1).value)
  1008. )
  1009. ) then
  1010. result:=cnothingnode.create;
  1011. end;
  1012. function tfornode.pass_typecheck:tnode;
  1013. var
  1014. res : tnode;
  1015. begin
  1016. result:=nil;
  1017. resultdef:=voidtype;
  1018. { process the loopvar, from and to, varstates are already set }
  1019. typecheckpass(left);
  1020. typecheckpass(right);
  1021. typecheckpass(t1);
  1022. set_varstate(left,vs_written,[]);
  1023. { loop unrolling }
  1024. if cs_opt_loopunroll in current_settings.optimizerswitches then
  1025. begin
  1026. res:=unroll_loop(self);
  1027. if assigned(res) then
  1028. begin
  1029. typecheckpass(res);
  1030. result:=res;
  1031. exit;
  1032. end;
  1033. end;
  1034. { Can we spare the first comparision? }
  1035. if (t1.nodetype=ordconstn) and
  1036. (right.nodetype=ordconstn) and
  1037. (
  1038. (
  1039. (lnf_backward in loopflags) and
  1040. (Tordconstnode(right).value>=Tordconstnode(t1).value)
  1041. ) or
  1042. (
  1043. not(lnf_backward in loopflags) and
  1044. (Tordconstnode(right).value<=Tordconstnode(t1).value)
  1045. )
  1046. ) then
  1047. exclude(loopflags,lnf_testatbegin);
  1048. { Make sure that the loop var and the
  1049. from and to values are compatible types }
  1050. check_ranges(right.fileinfo,right,left.resultdef);
  1051. inserttypeconv(right,left.resultdef);
  1052. check_ranges(t1.fileinfo,t1,left.resultdef);
  1053. inserttypeconv(t1,left.resultdef);
  1054. if assigned(t2) then
  1055. typecheckpass(t2);
  1056. end;
  1057. function tfornode.pass_1 : tnode;
  1058. begin
  1059. result:=nil;
  1060. expectloc:=LOC_VOID;
  1061. firstpass(left);
  1062. firstpass(right);
  1063. firstpass(t1);
  1064. if assigned(t2) then
  1065. begin
  1066. firstpass(t2);
  1067. if codegenerror then
  1068. exit;
  1069. end;
  1070. end;
  1071. {*****************************************************************************
  1072. TEXITNODE
  1073. *****************************************************************************}
  1074. constructor texitnode.create(l:tnode);
  1075. begin
  1076. inherited create(exitn,l);
  1077. end;
  1078. constructor texitnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  1079. begin
  1080. inherited ppuload(t,ppufile);
  1081. end;
  1082. procedure texitnode.ppuwrite(ppufile:tcompilerppufile);
  1083. begin
  1084. inherited ppuwrite(ppufile);
  1085. end;
  1086. function texitnode.pass_typecheck:tnode;
  1087. begin
  1088. result:=nil;
  1089. if assigned(left) then
  1090. begin
  1091. { add assignment to funcretsym }
  1092. inserttypeconv(left,current_procinfo.procdef.returndef);
  1093. left:=cassignmentnode.create(
  1094. cloadnode.create(current_procinfo.procdef.funcretsym,current_procinfo.procdef.funcretsym.owner),
  1095. left);
  1096. typecheckpass(left);
  1097. set_varstate(left,vs_read,[vsf_must_be_valid]);
  1098. end;
  1099. resultdef:=voidtype;
  1100. end;
  1101. function texitnode.pass_1 : tnode;
  1102. begin
  1103. result:=nil;
  1104. expectloc:=LOC_VOID;
  1105. if assigned(left) then
  1106. begin
  1107. firstpass(left);
  1108. if codegenerror then
  1109. exit;
  1110. end;
  1111. end;
  1112. {*****************************************************************************
  1113. TBREAKNODE
  1114. *****************************************************************************}
  1115. constructor tbreaknode.create;
  1116. begin
  1117. inherited create(breakn);
  1118. end;
  1119. function tbreaknode.pass_typecheck:tnode;
  1120. begin
  1121. result:=nil;
  1122. resultdef:=voidtype;
  1123. end;
  1124. function tbreaknode.pass_1 : tnode;
  1125. begin
  1126. result:=nil;
  1127. expectloc:=LOC_VOID;
  1128. end;
  1129. {*****************************************************************************
  1130. TCONTINUENODE
  1131. *****************************************************************************}
  1132. constructor tcontinuenode.create;
  1133. begin
  1134. inherited create(continuen);
  1135. end;
  1136. function tcontinuenode.pass_typecheck:tnode;
  1137. begin
  1138. result:=nil;
  1139. resultdef:=voidtype;
  1140. end;
  1141. function tcontinuenode.pass_1 : tnode;
  1142. begin
  1143. result:=nil;
  1144. expectloc:=LOC_VOID;
  1145. end;
  1146. {*****************************************************************************
  1147. TGOTONODE
  1148. *****************************************************************************}
  1149. constructor tgotonode.create(p : tlabelsym);
  1150. begin
  1151. inherited create(goton);
  1152. exceptionblock:=current_exceptblock;
  1153. labelnode:=nil;
  1154. labelsym:=p;
  1155. end;
  1156. constructor tgotonode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  1157. begin
  1158. inherited ppuload(t,ppufile);
  1159. labelnodeidx:=ppufile.getlongint;
  1160. exceptionblock:=ppufile.getbyte;
  1161. end;
  1162. procedure tgotonode.ppuwrite(ppufile:tcompilerppufile);
  1163. begin
  1164. inherited ppuwrite(ppufile);
  1165. labelnodeidx:=labelnode.ppuidx;
  1166. ppufile.putlongint(labelnodeidx);
  1167. ppufile.putbyte(exceptionblock);
  1168. end;
  1169. procedure tgotonode.buildderefimpl;
  1170. begin
  1171. inherited buildderefimpl;
  1172. end;
  1173. procedure tgotonode.derefimpl;
  1174. begin
  1175. inherited derefimpl;
  1176. end;
  1177. procedure tgotonode.resolveppuidx;
  1178. begin
  1179. labelnode:=tlabelnode(nodeppuidxget(labelnodeidx));
  1180. if labelnode.nodetype<>labeln then
  1181. internalerror(200809021);
  1182. end;
  1183. function tgotonode.pass_typecheck:tnode;
  1184. begin
  1185. result:=nil;
  1186. resultdef:=voidtype;
  1187. end;
  1188. function tgotonode.pass_1 : tnode;
  1189. begin
  1190. result:=nil;
  1191. expectloc:=LOC_VOID;
  1192. include(current_procinfo.flags,pi_has_goto);
  1193. { The labelnode can already be set when
  1194. this node was copied }
  1195. if not assigned(labelnode) then
  1196. begin
  1197. if assigned(labelsym.code) then
  1198. labelnode:=tlabelnode(labelsym.code)
  1199. else
  1200. CGMessage1(cg_e_goto_label_not_found,labelsym.realname);
  1201. end;
  1202. { check if we don't mess with exception blocks }
  1203. if assigned(labelnode) and
  1204. (exceptionblock<>labelnode.exceptionblock) then
  1205. CGMessage(cg_e_goto_inout_of_exception_block);
  1206. end;
  1207. function tgotonode.dogetcopy : tnode;
  1208. var
  1209. p : tgotonode;
  1210. begin
  1211. p:=tgotonode(inherited dogetcopy);
  1212. p.exceptionblock:=exceptionblock;
  1213. { generate labelnode if not done yet }
  1214. if not(assigned(labelnode)) then
  1215. begin
  1216. if assigned(labelsym) and assigned(labelsym.code) then
  1217. labelnode:=tlabelnode(labelsym.code)
  1218. end;
  1219. p.labelsym:=labelsym;
  1220. if assigned(labelnode) then
  1221. p.labelnode:=tlabelnode(labelnode.dogetcopy)
  1222. else
  1223. begin
  1224. { don't trigger IE when there was already an error, i.e. the
  1225. label is not defined. See tw11763 (PFV) }
  1226. if errorcount=0 then
  1227. internalerror(200610291);
  1228. end;
  1229. result:=p;
  1230. end;
  1231. function tgotonode.docompare(p: tnode): boolean;
  1232. begin
  1233. docompare := false;
  1234. end;
  1235. {*****************************************************************************
  1236. TLABELNODE
  1237. *****************************************************************************}
  1238. constructor tlabelnode.create(l:tnode;alabsym:tlabelsym);
  1239. begin
  1240. inherited create(labeln,l);
  1241. exceptionblock:=current_exceptblock;
  1242. labsym:=alabsym;
  1243. { Register labelnode in labelsym }
  1244. labsym.code:=self;
  1245. end;
  1246. constructor tlabelnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  1247. begin
  1248. inherited ppuload(t,ppufile);
  1249. exceptionblock:=ppufile.getbyte;
  1250. end;
  1251. destructor tlabelnode.destroy;
  1252. begin
  1253. { Remove reference in labelsym, this is to prevent
  1254. goto's to this label }
  1255. if assigned(labsym) and (labsym.code=pointer(self)) then
  1256. labsym.code:=nil;
  1257. inherited destroy;
  1258. end;
  1259. procedure tlabelnode.ppuwrite(ppufile:tcompilerppufile);
  1260. begin
  1261. inherited ppuwrite(ppufile);
  1262. ppufile.putbyte(exceptionblock);
  1263. end;
  1264. procedure tlabelnode.buildderefimpl;
  1265. begin
  1266. inherited buildderefimpl;
  1267. end;
  1268. procedure tlabelnode.derefimpl;
  1269. begin
  1270. inherited derefimpl;
  1271. end;
  1272. function tlabelnode.pass_typecheck:tnode;
  1273. begin
  1274. result:=nil;
  1275. { left could still be unassigned }
  1276. if assigned(left) then
  1277. typecheckpass(left);
  1278. resultdef:=voidtype;
  1279. end;
  1280. function tlabelnode.pass_1 : tnode;
  1281. begin
  1282. result:=nil;
  1283. expectloc:=LOC_VOID;
  1284. if assigned(left) then
  1285. firstpass(left);
  1286. end;
  1287. function tlabelnode.dogetcopy : tnode;
  1288. begin
  1289. if not(assigned(copiedto)) then
  1290. copiedto:=tlabelnode(inherited dogetcopy);
  1291. copiedto.exceptionblock:=exceptionblock;
  1292. result:=copiedto;
  1293. end;
  1294. function tlabelnode.docompare(p: tnode): boolean;
  1295. begin
  1296. docompare := false;
  1297. end;
  1298. {*****************************************************************************
  1299. TRAISENODE
  1300. *****************************************************************************}
  1301. constructor traisenode.create(l,taddr,tframe:tnode);
  1302. begin
  1303. inherited create(raisen,l,taddr,tframe);
  1304. end;
  1305. function traisenode.pass_typecheck:tnode;
  1306. begin
  1307. result:=nil;
  1308. resultdef:=voidtype;
  1309. if assigned(left) then
  1310. begin
  1311. { first para must be a _class_ }
  1312. typecheckpass(left);
  1313. set_varstate(left,vs_read,[vsf_must_be_valid]);
  1314. if codegenerror then
  1315. exit;
  1316. if not(is_class(left.resultdef)) then
  1317. CGMessage1(type_e_class_type_expected,left.resultdef.typename);
  1318. { insert needed typeconvs for addr,frame }
  1319. if assigned(right) then
  1320. begin
  1321. { addr }
  1322. typecheckpass(right);
  1323. inserttypeconv(right,voidpointertype);
  1324. { frame }
  1325. if assigned(third) then
  1326. begin
  1327. typecheckpass(third);
  1328. inserttypeconv(third,voidpointertype);
  1329. end;
  1330. end;
  1331. end;
  1332. end;
  1333. function traisenode.pass_1 : tnode;
  1334. begin
  1335. result:=nil;
  1336. include(current_procinfo.flags,pi_do_call);
  1337. expectloc:=LOC_VOID;
  1338. if assigned(left) then
  1339. begin
  1340. { first para must be a _class_ }
  1341. firstpass(left);
  1342. { insert needed typeconvs for addr,frame }
  1343. if assigned(right) then
  1344. begin
  1345. { addr }
  1346. firstpass(right);
  1347. { frame }
  1348. if assigned(third) then
  1349. firstpass(third);
  1350. end;
  1351. end;
  1352. end;
  1353. {*****************************************************************************
  1354. TTRYEXCEPTNODE
  1355. *****************************************************************************}
  1356. constructor ttryexceptnode.create(l,r,_t1 : tnode);
  1357. begin
  1358. inherited create(tryexceptn,l,r,_t1,nil);
  1359. end;
  1360. function ttryexceptnode.pass_typecheck:tnode;
  1361. begin
  1362. result:=nil;
  1363. typecheckpass(left);
  1364. { on statements }
  1365. if assigned(right) then
  1366. typecheckpass(right);
  1367. { else block }
  1368. if assigned(t1) then
  1369. typecheckpass(t1);
  1370. resultdef:=voidtype;
  1371. end;
  1372. function ttryexceptnode.pass_1 : tnode;
  1373. begin
  1374. result:=nil;
  1375. include(current_procinfo.flags,pi_do_call);
  1376. expectloc:=LOC_VOID;
  1377. firstpass(left);
  1378. { on statements }
  1379. if assigned(right) then
  1380. firstpass(right);
  1381. { else block }
  1382. if assigned(t1) then
  1383. firstpass(t1);
  1384. end;
  1385. {*****************************************************************************
  1386. TTRYFINALLYNODE
  1387. *****************************************************************************}
  1388. constructor ttryfinallynode.create(l,r:tnode);
  1389. begin
  1390. inherited create(tryfinallyn,l,r,nil,nil);
  1391. implicitframe:=false;
  1392. end;
  1393. constructor ttryfinallynode.create_implicit(l,r,_t1:tnode);
  1394. begin
  1395. inherited create(tryfinallyn,l,r,_t1,nil);
  1396. implicitframe:=true;
  1397. end;
  1398. function ttryfinallynode.pass_typecheck:tnode;
  1399. begin
  1400. result:=nil;
  1401. include(current_procinfo.flags,pi_do_call);
  1402. resultdef:=voidtype;
  1403. typecheckpass(left);
  1404. // "try block" is "used"? (JM)
  1405. set_varstate(left,vs_readwritten,[vsf_must_be_valid]);
  1406. typecheckpass(right);
  1407. // "except block" is "used"? (JM)
  1408. set_varstate(right,vs_readwritten,[vsf_must_be_valid]);
  1409. { special finally block only executed when there was an exception }
  1410. if assigned(t1) then
  1411. begin
  1412. typecheckpass(t1);
  1413. // "finally block" is "used"? (JM)
  1414. set_varstate(t1,vs_readwritten,[vsf_must_be_valid]);
  1415. end;
  1416. end;
  1417. function ttryfinallynode.pass_1 : tnode;
  1418. begin
  1419. result:=nil;
  1420. expectloc:=LOC_VOID;
  1421. firstpass(left);
  1422. firstpass(right);
  1423. if assigned(t1) then
  1424. firstpass(t1);
  1425. end;
  1426. function ttryfinallynode.simplify: tnode;
  1427. begin
  1428. result:=nil;
  1429. { if the try contains no code, we can kill
  1430. the try and except and return only the
  1431. finally part }
  1432. if has_no_code(left) then
  1433. begin
  1434. result:=right;
  1435. right:=nil;
  1436. end;
  1437. end;
  1438. {*****************************************************************************
  1439. TONNODE
  1440. *****************************************************************************}
  1441. constructor tonnode.create(l,r:tnode);
  1442. begin
  1443. inherited create(onn,l,r);
  1444. excepTSymtable:=nil;
  1445. excepttype:=nil;
  1446. end;
  1447. destructor tonnode.destroy;
  1448. begin
  1449. { copied nodes don't need to release the symtable }
  1450. if assigned(excepTSymtable) then
  1451. excepTSymtable.free;
  1452. inherited destroy;
  1453. end;
  1454. constructor tonnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  1455. begin
  1456. inherited ppuload(t,ppufile);
  1457. excepTSymtable:=nil;
  1458. excepttype:=nil;
  1459. end;
  1460. function tonnode.dogetcopy : tnode;
  1461. var
  1462. n : tonnode;
  1463. begin
  1464. n:=tonnode(inherited dogetcopy);
  1465. if assigned(exceptsymtable) then
  1466. n.exceptsymtable:=exceptsymtable.getcopy
  1467. else
  1468. n.exceptsymtable:=nil;
  1469. n.excepttype:=excepttype;
  1470. result:=n;
  1471. end;
  1472. function tonnode.pass_typecheck:tnode;
  1473. begin
  1474. result:=nil;
  1475. resultdef:=voidtype;
  1476. if not(is_class(excepttype)) then
  1477. CGMessage1(type_e_class_type_expected,excepttype.typename);
  1478. if assigned(left) then
  1479. typecheckpass(left);
  1480. if assigned(right) then
  1481. typecheckpass(right);
  1482. end;
  1483. function tonnode.pass_1 : tnode;
  1484. begin
  1485. result:=nil;
  1486. include(current_procinfo.flags,pi_do_call);
  1487. expectloc:=LOC_VOID;
  1488. if assigned(left) then
  1489. firstpass(left);
  1490. if assigned(right) then
  1491. firstpass(right);
  1492. end;
  1493. function tonnode.docompare(p: tnode): boolean;
  1494. begin
  1495. docompare := false;
  1496. end;
  1497. begin
  1498. cwhilerepeatnode:=twhilerepeatnode;
  1499. cifnode:=tifnode;
  1500. cfornode:=tfornode;
  1501. cexitnode:=texitnode;
  1502. cgotonode:=tgotonode;
  1503. clabelnode:=tlabelnode;
  1504. craisenode:=traisenode;
  1505. ctryexceptnode:=ttryexceptnode;
  1506. ctryfinallynode:=ttryfinallynode;
  1507. connode:=tonnode;
  1508. end.