nflw.pas 69 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081
  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_objc_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  222. var
  223. mainstatement, outerloopbodystatement, innerloopbodystatement, tempstatement: tstatementnode;
  224. state, mutationcheck, currentamount, innerloopcounter, items, expressiontemp: ttempcreatenode;
  225. outerloop, innerloop, hp: tnode;
  226. itemsarraydef: tarraydef;
  227. sym: tsym;
  228. begin
  229. { Objective-C enumerators require Objective-C 2.0 }
  230. if not(m_objectivec2 in current_settings.modeswitches) then
  231. begin
  232. result:=cerrornode.create;
  233. MessagePos(expr.fileinfo,parser_e_objc_enumerator_2_0);
  234. exit;
  235. end;
  236. { Requires the NSFastEnumeration protocol and NSFastEnumerationState
  237. record }
  238. maybeloadcocoatypes;
  239. if not assigned(objc_fastenumeration) or
  240. not assigned(objc_fastenumerationstate) then
  241. begin
  242. result:=cerrornode.create;
  243. MessagePos(expr.fileinfo,parser_e_objc_missing_enumeration_defs);
  244. exit;
  245. end;
  246. (* Original code:
  247. for hloopvar in expression do
  248. <hloopbody>
  249. Pascal code equivalent into which it has to be transformed
  250. (sure would be nice if the compiler had some kind of templates ;) :
  251. var
  252. state: NSFastEnumerationState;
  253. expressiontemp: NSFastEnumerationProtocol;
  254. mutationcheck,
  255. currentamount,
  256. innerloopcounter: culong;
  257. { size can be increased/decreased if desired }
  258. items: array[1..16] of id;
  259. begin
  260. fillchar(state,sizeof(state),0);
  261. expressiontemp:=expression;
  262. repeat
  263. currentamount:=expressiontemp.countByEnumeratingWithState_objects_count(@state,@items,length(items));
  264. if currentamount=0 then
  265. begin
  266. { "The iterating variable is set to nil when the loop ends by
  267. exhausting the source pool of objects" }
  268. hloopvar:=nil;
  269. break;
  270. end;
  271. mutationcheck:=state.mutationsptr^;
  272. innerloopcounter:=culong(-1);
  273. repeat
  274. { at the start so that "continue" in <loopbody> works correctly }
  275. { don't use for-loop, because then the value of the iteration
  276. counter is undefined on exit and we have to check it in the
  277. outer repeat/until condition }
  278. {$push}
  279. {$r-,q-}
  280. inc(innerloopcounter);
  281. {$pop}
  282. if innerloopcounter=currentamount then
  283. break;
  284. if mutationcheck<>state.mutationsptr^ then
  285. { raises Objective-C exception... }
  286. objc_enumerationMutation(expressiontemp);
  287. hloopvar:=state.itemsPtr[innerloopcounter];
  288. { if continue in loopbody -> jumps to start, increases count and checks }
  289. { if break in loopbody: goes to outer repeat/until and innerloopcount
  290. will be < currentamount -> stops }
  291. <hloopbody>
  292. until false;
  293. { if the inner loop terminated early, "break" was used and we have
  294. to stop }
  295. { "If the loop is terminated early, the iterating variable is left
  296. pointing to the last iteration item." }
  297. until innerloopcounter<currentamount;
  298. end;
  299. *)
  300. result:=internalstatements(mainstatement);
  301. { the fast enumeration state }
  302. state:=ctempcreatenode.create(objc_fastenumerationstate,objc_fastenumerationstate.size,tt_persistent,false);
  303. typecheckpass(tnode(state));
  304. addstatement(mainstatement,state);
  305. { the temporary items array }
  306. itemsarraydef:=tarraydef.create(1,16,u32inttype);
  307. itemsarraydef.elementdef:=objc_idtype;
  308. items:=ctempcreatenode.create(itemsarraydef,itemsarraydef.size,tt_persistent,false);
  309. addstatement(mainstatement,items);
  310. typecheckpass(tnode(items));
  311. { temp for the expression/collection through which we iterate }
  312. expressiontemp:=ctempcreatenode.create(objc_fastenumeration,objc_fastenumeration.size,tt_persistent,true);
  313. addstatement(mainstatement,expressiontemp);
  314. { currentamount temp (not really clean: we use ptruint instead of
  315. culong) }
  316. currentamount:=ctempcreatenode.create(ptruinttype,ptruinttype.size,tt_persistent,true);
  317. typecheckpass(tnode(currentamount));
  318. addstatement(mainstatement,currentamount);
  319. { mutationcheck temp (idem) }
  320. mutationcheck:=ctempcreatenode.create(ptruinttype,ptruinttype.size,tt_persistent,true);
  321. typecheckpass(tnode(mutationcheck));
  322. addstatement(mainstatement,mutationcheck);
  323. { innerloopcounter temp (idem) }
  324. innerloopcounter:=ctempcreatenode.create(ptruinttype,ptruinttype.size,tt_persistent,true);
  325. typecheckpass(tnode(innerloopcounter));
  326. addstatement(mainstatement,innerloopcounter);
  327. { initialise the state with 0 }
  328. addstatement(mainstatement,ccallnode.createinternfromunit('SYSTEM','FILLCHAR',
  329. ccallparanode.create(genintconstnode(0),
  330. ccallparanode.create(genintconstnode(objc_fastenumerationstate.size),
  331. ccallparanode.create(ctemprefnode.create(state),nil)
  332. )
  333. )
  334. ));
  335. { this will also check whether the expression (potentially) conforms
  336. to the NSFastEnumeration protocol (use expr.getcopy, because the
  337. caller will free expr) }
  338. addstatement(mainstatement,cassignmentnode.create(ctemprefnode.create(expressiontemp),expr.getcopy));
  339. { we add the "repeat..until" afterwards, now just create the body }
  340. outerloop:=internalstatements(outerloopbodystatement);
  341. { the countByEnumeratingWithState_objects_count call }
  342. hp:=ccallparanode.create(cinlinenode.create(in_length_x,false,ctypenode.create(itemsarraydef)),
  343. ccallparanode.create(caddrnode.create(ctemprefnode.create(items)),
  344. ccallparanode.create(caddrnode.create(ctemprefnode.create(state)),nil)
  345. )
  346. );
  347. sym:=search_class_member(objc_fastenumeration,'COUNTBYENUMERATINGWITHSTATE_OBJECTS_COUNT');
  348. if not assigned(sym) or
  349. (sym.typ<>procsym) then
  350. internalerror(2010061901);
  351. hp:=ccallnode.create(hp,tprocsym(sym),sym.owner,ctemprefnode.create(expressiontemp),[]);
  352. addstatement(outerloopbodystatement,cassignmentnode.create(
  353. ctemprefnode.create(currentamount),hp));
  354. { if currentamount = 0, bail out (use copy of hloopvar, because we
  355. have to use it again below) }
  356. hp:=internalstatements(tempstatement);
  357. addstatement(tempstatement,cassignmentnode.create(
  358. hloopvar.getcopy,cnilnode.create));
  359. addstatement(tempstatement,cbreaknode.create);
  360. addstatement(outerloopbodystatement,cifnode.create(
  361. caddnode.create(equaln,ctemprefnode.create(currentamount),genintconstnode(0)),
  362. hp,nil));
  363. { initial value of mutationcheck }
  364. hp:=ctemprefnode.create(state);
  365. typecheckpass(hp);
  366. hp:=cderefnode.create(genloadfield(hp,'MUTATIONSPTR'));
  367. addstatement(outerloopbodystatement,cassignmentnode.create(
  368. ctemprefnode.create(mutationcheck),hp));
  369. { initialise innerloopcounter }
  370. addstatement(outerloopbodystatement,cassignmentnode.create(
  371. ctemprefnode.create(innerloopcounter),cordconstnode.create(-1,ptruinttype,false)));
  372. { and now the inner loop, again adding the repeat/until afterwards }
  373. innerloop:=internalstatements(innerloopbodystatement);
  374. { inc(innerloopcounter) without range/overflowchecking (because
  375. we go from culong(-1) to 0 during the first iteration }
  376. hp:=cinlinenode.create(
  377. in_inc_x,false,ccallparanode.create(
  378. ctemprefnode.create(innerloopcounter),nil));
  379. hp.localswitches:=hp.localswitches-[cs_check_range,cs_check_overflow];
  380. addstatement(innerloopbodystatement,hp);
  381. { if innerloopcounter=currentamount then break to the outer loop }
  382. addstatement(innerloopbodystatement,cifnode.create(
  383. caddnode.create(equaln,
  384. ctemprefnode.create(innerloopcounter),
  385. ctemprefnode.create(currentamount)),
  386. cbreaknode.create,
  387. nil));
  388. { verify that the collection didn't change in the mean time }
  389. hp:=ctemprefnode.create(state);
  390. typecheckpass(hp);
  391. addstatement(innerloopbodystatement,cifnode.create(
  392. caddnode.create(unequaln,
  393. ctemprefnode.create(mutationcheck),
  394. cderefnode.create(genloadfield(hp,'MUTATIONSPTR'))
  395. ),
  396. ccallnode.createinternfromunit('OBJC','OBJC_ENUMERATIONMUTATION',
  397. ccallparanode.create(ctemprefnode.create(expressiontemp),nil)),
  398. nil));
  399. { finally: actually get the next element }
  400. hp:=ctemprefnode.create(state);
  401. typecheckpass(hp);
  402. hp:=genloadfield(hp,'ITEMSPTR');
  403. typecheckpass(hp);
  404. { don't simply use a vecn, because indexing a pointer won't work in
  405. non-FPC modes }
  406. if hp.resultdef.typ<>pointerdef then
  407. internalerror(2010061904);
  408. inserttypeconv(hp,
  409. tarraydef.create_from_pointer(tpointerdef(hp.resultdef).pointeddef));
  410. hp:=cvecnode.create(hp,ctemprefnode.create(innerloopcounter));
  411. addstatement(innerloopbodystatement,
  412. cassignmentnode.create(hloopvar,hp));
  413. { the actual loop body! }
  414. addstatement(innerloopbodystatement,hloopbody);
  415. { create the inner repeat/until and add it to the body of the outer
  416. one }
  417. hp:=cwhilerepeatnode.create(
  418. { repeat .. until false }
  419. cordconstnode.create(0,booltype,false),innerloop,false,true);
  420. addstatement(outerloopbodystatement,hp);
  421. { create the outer repeat/until and add it to the the main body }
  422. hp:=cwhilerepeatnode.create(
  423. { repeat .. until innerloopcounter<currentamount }
  424. caddnode.create(ltn,
  425. ctemprefnode.create(innerloopcounter),
  426. ctemprefnode.create(currentamount)),
  427. outerloop,false,true);
  428. addstatement(mainstatement,hp);
  429. { release the temps }
  430. addstatement(mainstatement,ctempdeletenode.create(state));
  431. addstatement(mainstatement,ctempdeletenode.create(mutationcheck));
  432. addstatement(mainstatement,ctempdeletenode.create(currentamount));
  433. addstatement(mainstatement,ctempdeletenode.create(innerloopcounter));
  434. addstatement(mainstatement,ctempdeletenode.create(items));
  435. addstatement(mainstatement,ctempdeletenode.create(expressiontemp));
  436. end;
  437. function create_string_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  438. var
  439. loopstatement, loopbodystatement: tstatementnode;
  440. loopvar, stringvar: ttempcreatenode;
  441. stringindex, loopbody, forloopnode: tnode;
  442. begin
  443. { result is a block of statements }
  444. result:=internalstatements(loopstatement);
  445. { create a temp variable for expression }
  446. stringvar := ctempcreatenode.create(
  447. expr.resultdef,
  448. expr.resultdef.size,
  449. tt_persistent,true);
  450. addstatement(loopstatement,stringvar);
  451. addstatement(loopstatement,cassignmentnode.create(ctemprefnode.create(stringvar),expr.getcopy));
  452. { create a loop counter: signed integer with size of string length }
  453. loopvar := ctempcreatenode.create(
  454. sinttype,
  455. sinttype.size,
  456. tt_persistent,true);
  457. addstatement(loopstatement,loopvar);
  458. stringindex:=ctemprefnode.create(loopvar);
  459. loopbody:=internalstatements(loopbodystatement);
  460. // for-in loop variable := string_expression[index]
  461. addstatement(loopbodystatement,
  462. cassignmentnode.create(hloopvar, cvecnode.create(ctemprefnode.create(stringvar),stringindex)));
  463. { add the actual statement to the loop }
  464. addstatement(loopbodystatement,hloopbody);
  465. forloopnode:=cfornode.create(ctemprefnode.create(loopvar),
  466. genintconstnode(1),
  467. cinlinenode.create(in_length_x,false,ctemprefnode.create(stringvar)),
  468. loopbody,
  469. false);
  470. addstatement(loopstatement,forloopnode);
  471. { free the loop counter }
  472. addstatement(loopstatement,ctempdeletenode.create(loopvar));
  473. { free the temp variable for expression }
  474. addstatement(loopstatement,ctempdeletenode.create(stringvar));
  475. end;
  476. function create_array_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  477. var
  478. loopstatement, loopbodystatement: tstatementnode;
  479. loopvar, arrayvar: ttempcreatenode;
  480. arrayindex, lowbound, highbound, loopbody, forloopnode, expression: tnode;
  481. is_string: boolean;
  482. tmpdef, convertdef: tdef;
  483. elementcount: aword;
  484. begin
  485. expression := expr;
  486. { result is a block of statements }
  487. result:=internalstatements(loopstatement);
  488. is_string:=ado_IsConstString in tarraydef(expr.resultdef).arrayoptions;
  489. // if array element type <> loovar type then create a conversion if possible
  490. if compare_defs(tarraydef(expression.resultdef).elementdef,hloopvar.resultdef,nothingn)=te_incompatible then
  491. begin
  492. tmpdef:=expression.resultdef;
  493. elementcount:=1;
  494. while assigned(tmpdef) and (tmpdef.typ=arraydef) and
  495. (tarraydef(tmpdef).arrayoptions = []) and
  496. (compare_defs(tarraydef(tmpdef).elementdef,hloopvar.resultdef,nothingn)=te_incompatible) do
  497. begin
  498. elementcount:=elementcount*tarraydef(tmpdef).elecount;
  499. tmpdef:=tarraydef(tmpdef).elementdef;
  500. end;
  501. if assigned(tmpdef) and (tmpdef.typ=arraydef) and (tarraydef(tmpdef).arrayoptions = []) then
  502. begin
  503. elementcount:=elementcount*tarraydef(tmpdef).elecount;
  504. convertdef:=tarraydef.create(0,elementcount-1,s32inttype);
  505. tarraydef(convertdef).elementdef:=tarraydef(tmpdef).elementdef;
  506. expression:=expr.getcopy;
  507. expression:=ctypeconvnode.create_internal(expression,convertdef);
  508. typecheckpass(expression);
  509. addstatement(loopstatement,expression);
  510. end;
  511. end;
  512. if (node_complexity(expression) > 1) and not is_open_array(expression.resultdef) then
  513. begin
  514. { create a temp variable for expression }
  515. arrayvar := ctempcreatenode.create(
  516. expression.resultdef,
  517. expression.resultdef.size,
  518. tt_persistent,true);
  519. if is_string then
  520. begin
  521. lowbound:=genintconstnode(1);
  522. highbound:=cinlinenode.create(in_length_x,false,ctemprefnode.create(arrayvar))
  523. end
  524. else
  525. begin
  526. lowbound:=cinlinenode.create(in_low_x,false,ctemprefnode.create(arrayvar));
  527. highbound:=cinlinenode.create(in_high_x,false,ctemprefnode.create(arrayvar));
  528. end;
  529. addstatement(loopstatement,arrayvar);
  530. addstatement(loopstatement,cassignmentnode.create(ctemprefnode.create(arrayvar),expression.getcopy));
  531. end
  532. else
  533. begin
  534. arrayvar:=nil;
  535. if is_string then
  536. begin
  537. lowbound:=genintconstnode(1);
  538. highbound:=cinlinenode.create(in_length_x,false,expression.getcopy);
  539. end
  540. else
  541. begin
  542. lowbound:=cinlinenode.create(in_low_x,false,expression.getcopy);
  543. highbound:=cinlinenode.create(in_high_x,false,expression.getcopy);
  544. end;
  545. end;
  546. { create a loop counter }
  547. loopvar := ctempcreatenode.create(
  548. tarraydef(expression.resultdef).rangedef,
  549. tarraydef(expression.resultdef).rangedef.size,
  550. tt_persistent,true);
  551. addstatement(loopstatement,loopvar);
  552. arrayindex:=ctemprefnode.create(loopvar);
  553. loopbody:=internalstatements(loopbodystatement);
  554. // for-in loop variable := array_expression[index]
  555. if assigned(arrayvar) then
  556. addstatement(loopbodystatement,
  557. cassignmentnode.create(hloopvar,cvecnode.create(ctemprefnode.create(arrayvar),arrayindex)))
  558. else
  559. addstatement(loopbodystatement,
  560. cassignmentnode.create(hloopvar,cvecnode.create(expression.getcopy,arrayindex)));
  561. { add the actual statement to the loop }
  562. addstatement(loopbodystatement,hloopbody);
  563. forloopnode:=cfornode.create(ctemprefnode.create(loopvar),
  564. lowbound,
  565. highbound,
  566. loopbody,
  567. false);
  568. addstatement(loopstatement,forloopnode);
  569. { free the loop counter }
  570. addstatement(loopstatement,ctempdeletenode.create(loopvar));
  571. { free the temp variable for expression if needed }
  572. if arrayvar<>nil then
  573. addstatement(loopstatement,ctempdeletenode.create(arrayvar));
  574. end;
  575. function create_set_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  576. var
  577. loopstatement, loopbodystatement: tstatementnode;
  578. loopvar, setvar: ttempcreatenode;
  579. loopbody, forloopnode: tnode;
  580. begin
  581. // first check is set is empty and if it so then skip other processing
  582. if not Assigned(tsetdef(expr.resultdef).elementdef) then
  583. begin
  584. result:=cnothingnode.create;
  585. // free unused nodes
  586. hloopvar.free;
  587. hloopbody.free;
  588. exit;
  589. end;
  590. { result is a block of statements }
  591. result:=internalstatements(loopstatement);
  592. { create a temp variable for expression }
  593. setvar := ctempcreatenode.create(
  594. expr.resultdef,
  595. expr.resultdef.size,
  596. tt_persistent,true);
  597. addstatement(loopstatement,setvar);
  598. addstatement(loopstatement,cassignmentnode.create(ctemprefnode.create(setvar),expr.getcopy));
  599. { create a loop counter }
  600. loopvar := ctempcreatenode.create(
  601. tsetdef(expr.resultdef).elementdef,
  602. tsetdef(expr.resultdef).elementdef.size,
  603. tt_persistent,true);
  604. addstatement(loopstatement,loopvar);
  605. // if loopvar in set then
  606. // begin
  607. // hloopvar := loopvar
  608. // for-in loop body
  609. // end
  610. loopbody:=cifnode.create(
  611. cinnode.create(ctemprefnode.create(loopvar),ctemprefnode.create(setvar)),
  612. internalstatements(loopbodystatement),
  613. nil);
  614. addstatement(loopbodystatement,cassignmentnode.create(hloopvar,ctemprefnode.create(loopvar)));
  615. { add the actual statement to the loop }
  616. addstatement(loopbodystatement,hloopbody);
  617. forloopnode:=cfornode.create(ctemprefnode.create(loopvar),
  618. cinlinenode.create(in_low_x,false,ctemprefnode.create(setvar)),
  619. cinlinenode.create(in_high_x,false,ctemprefnode.create(setvar)),
  620. loopbody,
  621. false);
  622. addstatement(loopstatement,forloopnode);
  623. { free the loop counter }
  624. addstatement(loopstatement,ctempdeletenode.create(loopvar));
  625. { free the temp variable for expression }
  626. addstatement(loopstatement,ctempdeletenode.create(setvar));
  627. end;
  628. function create_enumerator_for_in_loop(hloopvar, hloopbody, expr: tnode;
  629. enumerator_get, enumerator_move: tprocdef; enumerator_current: tpropertysym): tnode;
  630. var
  631. loopstatement, loopbodystatement: tstatementnode;
  632. enumvar: ttempcreatenode;
  633. loopbody, whileloopnode,
  634. enum_get, enum_move, enum_current, enum_get_params: tnode;
  635. propaccesslist: tpropaccesslist;
  636. enumerator_is_class: boolean;
  637. enumerator_destructor: tprocdef;
  638. begin
  639. { result is a block of statements }
  640. result:=internalstatements(loopstatement);
  641. enumerator_is_class := is_class(enumerator_get.returndef);
  642. { create a temp variable for enumerator }
  643. enumvar := ctempcreatenode.create(
  644. enumerator_get.returndef,
  645. enumerator_get.returndef.size,
  646. tt_persistent,true);
  647. addstatement(loopstatement,enumvar);
  648. if enumerator_get.proctypeoption=potype_operator then
  649. begin
  650. enum_get_params:=ccallparanode.create(expr.getcopy,nil);
  651. enum_get:=ccallnode.create(enum_get_params, tprocsym(enumerator_get.procsym), nil, nil, []);
  652. tcallnode(enum_get).procdefinition:=enumerator_get;
  653. addsymref(enumerator_get.procsym);
  654. end
  655. else
  656. enum_get:=ccallnode.create(nil, tprocsym(enumerator_get.procsym), enumerator_get.owner, expr.getcopy, []);
  657. addstatement(loopstatement,
  658. cassignmentnode.create(
  659. ctemprefnode.create(enumvar),
  660. enum_get
  661. ));
  662. loopbody:=internalstatements(loopbodystatement);
  663. { for-in loop variable := enumerator.current }
  664. if getpropaccesslist(enumerator_current,palt_read,propaccesslist) then
  665. begin
  666. case propaccesslist.firstsym^.sym.typ of
  667. fieldvarsym :
  668. begin
  669. { generate access code }
  670. enum_current:=ctemprefnode.create(enumvar);
  671. propaccesslist_to_node(enum_current,enumerator_current.owner,propaccesslist);
  672. include(enum_current.flags,nf_isproperty);
  673. end;
  674. procsym :
  675. begin
  676. { generate the method call }
  677. enum_current:=ccallnode.create(nil,tprocsym(propaccesslist.firstsym^.sym),enumerator_current.owner,ctemprefnode.create(enumvar),[]);
  678. include(enum_current.flags,nf_isproperty);
  679. end
  680. else
  681. begin
  682. enum_current:=cerrornode.create;
  683. Message(type_e_mismatch);
  684. end;
  685. end;
  686. end
  687. else
  688. enum_current:=cerrornode.create;
  689. addstatement(loopbodystatement,
  690. cassignmentnode.create(hloopvar, enum_current));
  691. { add the actual statement to the loop }
  692. addstatement(loopbodystatement,hloopbody);
  693. enum_move:=ccallnode.create(nil, tprocsym(enumerator_move.procsym), enumerator_move.owner, ctemprefnode.create(enumvar), []);
  694. whileloopnode:=cwhilerepeatnode.create(enum_move,loopbody,true,false);
  695. if enumerator_is_class then
  696. begin
  697. { insert a try-finally and call the destructor for the enumerator in the finally section }
  698. enumerator_destructor:=tobjectdef(enumerator_get.returndef).find_destructor;
  699. if assigned(enumerator_destructor) then
  700. begin
  701. whileloopnode:=ctryfinallynode.create(
  702. whileloopnode, // try node
  703. ccallnode.create(nil,tprocsym(enumerator_destructor.procsym), // finally node
  704. enumerator_destructor.procsym.owner,ctemprefnode.create(enumvar),[]));
  705. end;
  706. { if getenumerator <> nil then do the loop }
  707. whileloopnode:=cifnode.create(
  708. caddnode.create(unequaln, ctemprefnode.create(enumvar), cnilnode.create),
  709. whileloopnode,
  710. nil);
  711. end;
  712. addstatement(loopstatement, whileloopnode);
  713. if is_object(enumerator_get.returndef) then
  714. begin
  715. // call the object destructor too
  716. enumerator_destructor:=tobjectdef(enumerator_get.returndef).find_destructor;
  717. if assigned(enumerator_destructor) then
  718. begin
  719. addstatement(loopstatement,
  720. ccallnode.create(nil,tprocsym(enumerator_destructor.procsym),
  721. enumerator_destructor.procsym.owner,ctemprefnode.create(enumvar),[]));
  722. end;
  723. end;
  724. { free the temp variable for enumerator }
  725. addstatement(loopstatement,ctempdeletenode.create(enumvar));
  726. end;
  727. function create_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  728. var
  729. pd, movenext: tprocdef;
  730. current: tpropertysym;
  731. storefilepos: tfileposinfo;
  732. begin
  733. storefilepos:=current_filepos;
  734. current_filepos:=hloopvar.fileinfo;
  735. if expr.nodetype=typen then
  736. begin
  737. if (expr.resultdef.typ=enumdef) and tenumdef(expr.resultdef).has_jumps then
  738. begin
  739. result:=cerrornode.create;
  740. hloopvar.free;
  741. hloopbody.free;
  742. MessagePos1(expr.fileinfo,parser_e_for_in_loop_cannot_be_used_for_the_type,expr.resultdef.typename);
  743. end
  744. else
  745. result:=create_type_for_in_loop(hloopvar, hloopbody, expr);
  746. end
  747. else
  748. begin
  749. { loop is made for an expression }
  750. // Objective-C uses different conventions (and it's only supported for Objective-C 2.0)
  751. if is_objc_class_or_protocol(hloopvar.resultdef) or
  752. is_objc_class_or_protocol(expr.resultdef) then
  753. begin
  754. result:=create_objc_for_in_loop(hloopvar,hloopbody,expr);
  755. if result.nodetype=errorn then
  756. begin
  757. hloopvar.free;
  758. hloopbody.free;
  759. end;
  760. end
  761. else
  762. begin
  763. // search for operator first
  764. pd:=search_enumerator_operator(expr.resultdef);
  765. // if there is no operator then search for class/object enumerator method
  766. if (pd=nil) and (expr.resultdef.typ=objectdef) then
  767. pd:=tobjectdef(expr.resultdef).search_enumerator_get;
  768. if pd<>nil then
  769. begin
  770. // seach movenext and current symbols
  771. movenext:=tobjectdef(pd.returndef).search_enumerator_move;
  772. if movenext = nil then
  773. begin
  774. result:=cerrornode.create;
  775. hloopvar.free;
  776. hloopbody.free;
  777. MessagePos1(expr.fileinfo,sym_e_no_enumerator_move,pd.returndef.GetTypeName);
  778. end
  779. else
  780. begin
  781. current:=tpropertysym(tobjectdef(pd.returndef).search_enumerator_current);
  782. if current = nil then
  783. begin
  784. result:=cerrornode.create;
  785. hloopvar.free;
  786. hloopbody.free;
  787. MessagePos1(expr.fileinfo,sym_e_no_enumerator_current,pd.returndef.GetTypeName);
  788. end
  789. else
  790. result:=create_enumerator_for_in_loop(hloopvar, hloopbody, expr, pd, movenext, current);
  791. end;
  792. end
  793. else
  794. begin
  795. case expr.resultdef.typ of
  796. stringdef: result:=create_string_for_in_loop(hloopvar, hloopbody, expr);
  797. arraydef: result:=create_array_for_in_loop(hloopvar, hloopbody, expr);
  798. setdef: result:=create_set_for_in_loop(hloopvar, hloopbody, expr);
  799. else
  800. begin
  801. result:=cerrornode.create;
  802. hloopvar.free;
  803. hloopbody.free;
  804. MessagePos1(expr.fileinfo,sym_e_no_enumerator,expr.resultdef.GetTypeName);
  805. end;
  806. end;
  807. end;
  808. end;
  809. end;
  810. current_filepos:=storefilepos;
  811. end;
  812. {****************************************************************************
  813. TLOOPNODE
  814. *****************************************************************************}
  815. constructor tloopnode.create(tt : tnodetype;l,r,_t1,_t2 : tnode);
  816. begin
  817. inherited create(tt,l,r);
  818. t1:=_t1;
  819. t2:=_t2;
  820. fileinfo:=l.fileinfo;
  821. end;
  822. destructor tloopnode.destroy;
  823. begin
  824. t1.free;
  825. t2.free;
  826. inherited destroy;
  827. end;
  828. constructor tloopnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  829. begin
  830. inherited ppuload(t,ppufile);
  831. t1:=ppuloadnode(ppufile);
  832. t2:=ppuloadnode(ppufile);
  833. end;
  834. procedure tloopnode.ppuwrite(ppufile:tcompilerppufile);
  835. begin
  836. inherited ppuwrite(ppufile);
  837. ppuwritenode(ppufile,t1);
  838. ppuwritenode(ppufile,t2);
  839. end;
  840. procedure tloopnode.buildderefimpl;
  841. begin
  842. inherited buildderefimpl;
  843. if assigned(t1) then
  844. t1.buildderefimpl;
  845. if assigned(t2) then
  846. t2.buildderefimpl;
  847. end;
  848. procedure tloopnode.derefimpl;
  849. begin
  850. inherited derefimpl;
  851. if assigned(t1) then
  852. t1.derefimpl;
  853. if assigned(t2) then
  854. t2.derefimpl;
  855. end;
  856. function tloopnode.dogetcopy : tnode;
  857. var
  858. p : tloopnode;
  859. begin
  860. p:=tloopnode(inherited dogetcopy);
  861. if assigned(t1) then
  862. p.t1:=t1.dogetcopy
  863. else
  864. p.t1:=nil;
  865. if assigned(t2) then
  866. p.t2:=t2.dogetcopy
  867. else
  868. p.t2:=nil;
  869. p.loopflags:=loopflags;
  870. dogetcopy:=p;
  871. end;
  872. procedure tloopnode.insertintolist(l : tnodelist);
  873. begin
  874. end;
  875. procedure tloopnode.printnodetree(var t:text);
  876. begin
  877. write(t,printnodeindention,'(');
  878. printnodeindent;
  879. printnodeinfo(t);
  880. writeln(t);
  881. printnode(t,left);
  882. printnode(t,right);
  883. printnode(t,t1);
  884. printnode(t,t2);
  885. printnodeunindent;
  886. writeln(t,printnodeindention,')');
  887. end;
  888. function tloopnode.docompare(p: tnode): boolean;
  889. begin
  890. docompare :=
  891. inherited docompare(p) and
  892. (loopflags*loopflagsequal=tloopnode(p).loopflags*loopflagsequal) and
  893. t1.isequal(tloopnode(p).t1) and
  894. t2.isequal(tloopnode(p).t2);
  895. end;
  896. {****************************************************************************
  897. TWHILEREPEATNODE
  898. *****************************************************************************}
  899. constructor Twhilerepeatnode.create(l,r:Tnode;tab,cn:boolean);
  900. begin
  901. inherited create(whilerepeatn,l,r,nil,nil);
  902. if tab then
  903. include(loopflags, lnf_testatbegin);
  904. if cn then
  905. include(loopflags,lnf_checknegate);
  906. end;
  907. function twhilerepeatnode.pass_typecheck:tnode;
  908. var
  909. t:Tunarynode;
  910. begin
  911. result:=nil;
  912. resultdef:=voidtype;
  913. typecheckpass(left);
  914. { tp procvar support }
  915. maybe_call_procvar(left,true);
  916. {A not node can be removed.}
  917. if left.nodetype=notn then
  918. begin
  919. t:=Tunarynode(left);
  920. left:=Tunarynode(left).left;
  921. t.left:=nil;
  922. t.destroy;
  923. {Symdif operator, in case you are wondering:}
  924. loopflags:=loopflags >< [lnf_checknegate];
  925. end;
  926. { loop instruction }
  927. if assigned(right) then
  928. typecheckpass(right);
  929. set_varstate(left,vs_read,[vsf_must_be_valid]);
  930. if codegenerror then
  931. exit;
  932. if not is_boolean(left.resultdef) then
  933. begin
  934. if left.resultdef.typ=variantdef then
  935. inserttypeconv(left,booltype)
  936. else
  937. CGMessage1(type_e_boolean_expr_expected,left.resultdef.typename);
  938. end;
  939. { Give warnings for code that will never be executed for
  940. while false do }
  941. if (lnf_testatbegin in loopflags) and
  942. (left.nodetype=ordconstn) and
  943. (tordconstnode(left).value.uvalue=0) and
  944. assigned(right) then
  945. CGMessagePos(right.fileinfo,cg_w_unreachable_code);
  946. end;
  947. {$ifdef prefetchnext}
  948. type
  949. passignmentquery = ^tassignmentquery;
  950. tassignmentquery = record
  951. towhat: tnode;
  952. source: tassignmentnode;
  953. statementcount: cardinal;
  954. end;
  955. function checkassignment(var n: tnode; arg: pointer): foreachnoderesult;
  956. var
  957. query: passignmentquery absolute arg;
  958. temp, prederef: tnode;
  959. begin
  960. result := fen_norecurse_false;
  961. if (n.nodetype in [assignn,inlinen,forn,calln,whilerepeatn,casen,ifn]) then
  962. inc(query^.statementcount);
  963. { make sure there's something else in the loop besides going to the }
  964. { next item }
  965. if (query^.statementcount > 1) and
  966. (n.nodetype = assignn) then
  967. begin
  968. { skip type conversions of assignment target }
  969. temp := tassignmentnode(n).left;
  970. while (temp.nodetype = typeconvn) do
  971. temp := ttypeconvnode(temp).left;
  972. { assignment to x of the while assigned(x) check? }
  973. if not(temp.isequal(query^.towhat)) then
  974. exit;
  975. { right hand side of assignment dereferenced field of }
  976. { x? (no derefn in case of class) }
  977. temp := tassignmentnode(n).right;
  978. while (temp.nodetype = typeconvn) do
  979. temp := ttypeconvnode(temp).left;
  980. if (temp.nodetype <> subscriptn) then
  981. exit;
  982. prederef := tsubscriptnode(temp).left;
  983. temp := prederef;
  984. while (temp.nodetype = typeconvn) do
  985. temp := ttypeconvnode(temp).left;
  986. { see tests/test/prefetch1.pp }
  987. if (temp.nodetype = derefn) then
  988. temp := tderefnode(temp).left
  989. else
  990. temp := prederef;
  991. if temp.isequal(query^.towhat) then
  992. begin
  993. query^.source := tassignmentnode(n);
  994. result := fen_norecurse_true;
  995. end
  996. end
  997. { don't check nodes which can't contain an assignment or whose }
  998. { final assignment can vary a lot }
  999. else if not(n.nodetype in [calln,inlinen,casen,whilerepeatn,forn]) then
  1000. result := fen_false;
  1001. end;
  1002. function findassignment(where: tnode; towhat: tnode): tassignmentnode;
  1003. var
  1004. query: tassignmentquery;
  1005. begin
  1006. query.towhat := towhat;
  1007. query.source := nil;
  1008. query.statementcount := 0;
  1009. if foreachnodestatic(where,@checkassignment,@query) then
  1010. result := query.source
  1011. else
  1012. result := nil;
  1013. end;
  1014. {$endif prefetchnext}
  1015. function twhilerepeatnode.pass_1 : tnode;
  1016. {$ifdef prefetchnext}
  1017. var
  1018. runnernode, prefetchcode: tnode;
  1019. assignmentnode: tassignmentnode;
  1020. prefetchstatements: tstatementnode;
  1021. {$endif prefetchnext}
  1022. begin
  1023. result:=nil;
  1024. expectloc:=LOC_VOID;
  1025. firstpass(left);
  1026. if codegenerror then
  1027. exit;
  1028. { loop instruction }
  1029. if assigned(right) then
  1030. begin
  1031. firstpass(right);
  1032. if codegenerror then
  1033. exit;
  1034. end;
  1035. {$ifdef prefetchnext}
  1036. { do at the end so all complex typeconversions are already }
  1037. { converted to calln's }
  1038. if (cs_opt_level1 in current_settings.optimizerswitches) and
  1039. (lnf_testatbegin in loopflags) then
  1040. begin
  1041. { get first component of the while check }
  1042. runnernode := left;
  1043. while (runnernode.nodetype in [andn,orn,notn,xorn,typeconvn]) do
  1044. runnernode := tunarynode(runnernode).left;
  1045. { is it an assigned(x) check? }
  1046. if ((runnernode.nodetype = inlinen) and
  1047. (tinlinenode(runnernode).inlinenumber = in_assigned_x)) or
  1048. ((runnernode.nodetype = unequaln) and
  1049. (taddnode(runnernode).right.nodetype = niln)) then
  1050. begin
  1051. runnernode := tunarynode(runnernode).left;
  1052. { in case of in_assigned_x, there's a callparan in between }
  1053. if (runnernode.nodetype = callparan) then
  1054. runnernode := tcallparanode(runnernode).left;
  1055. while (runnernode.nodetype = typeconvn) do
  1056. runnernode := ttypeconvnode(runnernode).left;
  1057. { is there an "x := x(^).somefield"? }
  1058. assignmentnode := findassignment(right,runnernode);
  1059. if assigned(assignmentnode) then
  1060. begin
  1061. prefetchcode := internalstatements(prefetchstatements);
  1062. addstatement(prefetchstatements,geninlinenode(in_prefetch_var,false,
  1063. cderefnode.create(ctypeconvnode.create(assignmentnode.right.getcopy,voidpointertype))));
  1064. addstatement(prefetchstatements,right);
  1065. right := prefetchcode;
  1066. typecheckpass(right);
  1067. end;
  1068. end;
  1069. end;
  1070. {$endif prefetchnext}
  1071. end;
  1072. {$ifdef state_tracking}
  1073. function Twhilerepeatnode.track_state_pass(exec_known:boolean):boolean;
  1074. var condition:Tnode;
  1075. code:Tnode;
  1076. done:boolean;
  1077. value:boolean;
  1078. change:boolean;
  1079. firsttest:boolean;
  1080. factval:Tnode;
  1081. begin
  1082. track_state_pass:=false;
  1083. done:=false;
  1084. firsttest:=true;
  1085. {For repeat until statements, first do a pass through the code.}
  1086. if not(lnf_testatbegin in flags) then
  1087. begin
  1088. code:=right.getcopy;
  1089. if code.track_state_pass(exec_known) then
  1090. track_state_pass:=true;
  1091. code.destroy;
  1092. end;
  1093. repeat
  1094. condition:=left.getcopy;
  1095. code:=right.getcopy;
  1096. change:=condition.track_state_pass(exec_known);
  1097. factval:=aktstate.find_fact(left);
  1098. if factval<>nil then
  1099. begin
  1100. condition.destroy;
  1101. condition:=factval.getcopy;
  1102. change:=true;
  1103. end;
  1104. if change then
  1105. begin
  1106. track_state_pass:=true;
  1107. {Force new resultdef pass.}
  1108. condition.resultdef:=nil;
  1109. do_typecheckpass(condition);
  1110. end;
  1111. if is_constboolnode(condition) then
  1112. begin
  1113. {Try to turn a while loop into a repeat loop.}
  1114. if firsttest then
  1115. exclude(flags,testatbegin);
  1116. value:=(Tordconstnode(condition).value<>0) xor checknegate;
  1117. if value then
  1118. begin
  1119. if code.track_state_pass(exec_known) then
  1120. track_state_pass:=true;
  1121. end
  1122. else
  1123. done:=true;
  1124. end
  1125. else
  1126. begin
  1127. {Remove any modified variables from the state.}
  1128. code.track_state_pass(false);
  1129. done:=true;
  1130. end;
  1131. code.destroy;
  1132. condition.destroy;
  1133. firsttest:=false;
  1134. until done;
  1135. {The loop condition is also known, for example:
  1136. while i<10 do
  1137. begin
  1138. ...
  1139. end;
  1140. When the loop is done, we do know that i<10 = false.
  1141. }
  1142. condition:=left.getcopy;
  1143. if condition.track_state_pass(exec_known) then
  1144. begin
  1145. track_state_pass:=true;
  1146. {Force new resultdef pass.}
  1147. condition.resultdef:=nil;
  1148. do_typecheckpass(condition);
  1149. end;
  1150. if not is_constboolnode(condition) then
  1151. aktstate.store_fact(condition,
  1152. cordconstnode.create(byte(checknegate),booltype,true))
  1153. else
  1154. condition.destroy;
  1155. end;
  1156. {$endif}
  1157. {*****************************************************************************
  1158. TIFNODE
  1159. *****************************************************************************}
  1160. constructor tifnode.create(l,r,_t1 : tnode);
  1161. begin
  1162. inherited create(ifn,l,r,_t1,nil);
  1163. end;
  1164. function tifnode.internalsimplify(warn: boolean) : tnode;
  1165. begin
  1166. result:=nil;
  1167. { optimize constant expressions }
  1168. if (left.nodetype=ordconstn) then
  1169. begin
  1170. if tordconstnode(left).value.uvalue=1 then
  1171. begin
  1172. if assigned(right) then
  1173. result:=right
  1174. else
  1175. result:=cnothingnode.create;
  1176. right:=nil;
  1177. if warn and assigned(t1) then
  1178. CGMessagePos(t1.fileinfo,cg_w_unreachable_code);
  1179. end
  1180. else
  1181. begin
  1182. if assigned(t1) then
  1183. result:=t1
  1184. else
  1185. result:=cnothingnode.create;
  1186. t1:=nil;
  1187. if warn and assigned(right) then
  1188. CGMessagePos(right.fileinfo,cg_w_unreachable_code);
  1189. end;
  1190. end;
  1191. end;
  1192. function tifnode.simplify : tnode;
  1193. begin
  1194. result:=internalsimplify(false);
  1195. end;
  1196. function tifnode.pass_typecheck:tnode;
  1197. begin
  1198. result:=nil;
  1199. resultdef:=voidtype;
  1200. typecheckpass(left);
  1201. { tp procvar support }
  1202. maybe_call_procvar(left,true);
  1203. { if path }
  1204. if assigned(right) then
  1205. typecheckpass(right);
  1206. { else path }
  1207. if assigned(t1) then
  1208. typecheckpass(t1);
  1209. set_varstate(left,vs_read,[vsf_must_be_valid]);
  1210. if codegenerror then
  1211. exit;
  1212. if not is_boolean(left.resultdef) then
  1213. begin
  1214. if left.resultdef.typ=variantdef then
  1215. inserttypeconv(left,booltype)
  1216. else
  1217. Message1(type_e_boolean_expr_expected,left.resultdef.typename);
  1218. end;
  1219. result:=internalsimplify(true);
  1220. end;
  1221. function tifnode.pass_1 : tnode;
  1222. begin
  1223. result:=nil;
  1224. expectloc:=LOC_VOID;
  1225. firstpass(left);
  1226. { if path }
  1227. if assigned(right) then
  1228. firstpass(right);
  1229. { else path }
  1230. if assigned(t1) then
  1231. firstpass(t1);
  1232. { leave if we've got an error in one of the paths }
  1233. if codegenerror then
  1234. exit;
  1235. end;
  1236. {*****************************************************************************
  1237. TFORNODE
  1238. *****************************************************************************}
  1239. constructor tfornode.create(l,r,_t1,_t2 : tnode;back : boolean);
  1240. begin
  1241. inherited create(forn,l,r,_t1,_t2);
  1242. if back then
  1243. include(loopflags,lnf_backward);
  1244. include(loopflags,lnf_testatbegin);
  1245. end;
  1246. procedure Tfornode.loop_var_access(not_type:Tnotification_flag;
  1247. symbol:Tsym);
  1248. begin
  1249. {If there is a read access, the value of the loop counter is important;
  1250. at the end of the loop the loop variable should contain the value it
  1251. had in the last iteration.}
  1252. if not_type=vn_onwrite then
  1253. begin
  1254. writeln('Loopvar does not matter on exit');
  1255. end
  1256. else
  1257. begin
  1258. exclude(loopflags,lnf_dont_mind_loopvar_on_exit);
  1259. writeln('Loopvar does matter on exit');
  1260. end;
  1261. Tabstractvarsym(symbol).unregister_notification(loopvar_notid);
  1262. end;
  1263. function tfornode.simplify : tnode;
  1264. begin
  1265. result:=nil;
  1266. if (t1.nodetype=ordconstn) and
  1267. (right.nodetype=ordconstn) and
  1268. (
  1269. (
  1270. (lnf_backward in loopflags) and
  1271. (tordconstnode(right).value<tordconstnode(t1).value)
  1272. ) or
  1273. (
  1274. not(lnf_backward in loopflags) and
  1275. (tordconstnode(right).value>tordconstnode(t1).value)
  1276. )
  1277. ) then
  1278. result:=cnothingnode.create;
  1279. end;
  1280. function tfornode.pass_typecheck:tnode;
  1281. var
  1282. res : tnode;
  1283. begin
  1284. result:=nil;
  1285. resultdef:=voidtype;
  1286. { process the loopvar, from and to, varstates are already set }
  1287. typecheckpass(left);
  1288. typecheckpass(right);
  1289. typecheckpass(t1);
  1290. set_varstate(left,vs_written,[]);
  1291. { loop unrolling }
  1292. if cs_opt_loopunroll in current_settings.optimizerswitches then
  1293. begin
  1294. res:=unroll_loop(self);
  1295. if assigned(res) then
  1296. begin
  1297. typecheckpass(res);
  1298. result:=res;
  1299. exit;
  1300. end;
  1301. end;
  1302. { Can we spare the first comparision? }
  1303. if (t1.nodetype=ordconstn) and
  1304. (right.nodetype=ordconstn) and
  1305. (
  1306. (
  1307. (lnf_backward in loopflags) and
  1308. (Tordconstnode(right).value>=Tordconstnode(t1).value)
  1309. ) or
  1310. (
  1311. not(lnf_backward in loopflags) and
  1312. (Tordconstnode(right).value<=Tordconstnode(t1).value)
  1313. )
  1314. ) then
  1315. exclude(loopflags,lnf_testatbegin);
  1316. { Make sure that the loop var and the
  1317. from and to values are compatible types }
  1318. check_ranges(right.fileinfo,right,left.resultdef);
  1319. inserttypeconv(right,left.resultdef);
  1320. check_ranges(t1.fileinfo,t1,left.resultdef);
  1321. inserttypeconv(t1,left.resultdef);
  1322. if assigned(t2) then
  1323. typecheckpass(t2);
  1324. end;
  1325. function tfornode.pass_1 : tnode;
  1326. begin
  1327. result:=nil;
  1328. expectloc:=LOC_VOID;
  1329. firstpass(left);
  1330. firstpass(right);
  1331. firstpass(t1);
  1332. if assigned(t2) then
  1333. begin
  1334. firstpass(t2);
  1335. if codegenerror then
  1336. exit;
  1337. end;
  1338. end;
  1339. {*****************************************************************************
  1340. TEXITNODE
  1341. *****************************************************************************}
  1342. constructor texitnode.create(l:tnode);
  1343. begin
  1344. inherited create(exitn,l);
  1345. end;
  1346. constructor texitnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  1347. begin
  1348. inherited ppuload(t,ppufile);
  1349. end;
  1350. procedure texitnode.ppuwrite(ppufile:tcompilerppufile);
  1351. begin
  1352. inherited ppuwrite(ppufile);
  1353. end;
  1354. function texitnode.pass_typecheck:tnode;
  1355. begin
  1356. result:=nil;
  1357. if assigned(left) then
  1358. begin
  1359. { add assignment to funcretsym }
  1360. inserttypeconv(left,current_procinfo.procdef.returndef);
  1361. left:=cassignmentnode.create(
  1362. cloadnode.create(current_procinfo.procdef.funcretsym,current_procinfo.procdef.funcretsym.owner),
  1363. left);
  1364. typecheckpass(left);
  1365. set_varstate(left,vs_read,[vsf_must_be_valid]);
  1366. end;
  1367. resultdef:=voidtype;
  1368. end;
  1369. function texitnode.pass_1 : tnode;
  1370. begin
  1371. result:=nil;
  1372. expectloc:=LOC_VOID;
  1373. if assigned(left) then
  1374. begin
  1375. firstpass(left);
  1376. if codegenerror then
  1377. exit;
  1378. end;
  1379. end;
  1380. {*****************************************************************************
  1381. TBREAKNODE
  1382. *****************************************************************************}
  1383. constructor tbreaknode.create;
  1384. begin
  1385. inherited create(breakn);
  1386. end;
  1387. function tbreaknode.pass_typecheck:tnode;
  1388. begin
  1389. result:=nil;
  1390. resultdef:=voidtype;
  1391. end;
  1392. function tbreaknode.pass_1 : tnode;
  1393. begin
  1394. result:=nil;
  1395. expectloc:=LOC_VOID;
  1396. end;
  1397. {*****************************************************************************
  1398. TCONTINUENODE
  1399. *****************************************************************************}
  1400. constructor tcontinuenode.create;
  1401. begin
  1402. inherited create(continuen);
  1403. end;
  1404. function tcontinuenode.pass_typecheck:tnode;
  1405. begin
  1406. result:=nil;
  1407. resultdef:=voidtype;
  1408. end;
  1409. function tcontinuenode.pass_1 : tnode;
  1410. begin
  1411. result:=nil;
  1412. expectloc:=LOC_VOID;
  1413. end;
  1414. {*****************************************************************************
  1415. TGOTONODE
  1416. *****************************************************************************}
  1417. constructor tgotonode.create(p : tlabelsym);
  1418. begin
  1419. inherited create(goton);
  1420. exceptionblock:=current_exceptblock;
  1421. labelnode:=nil;
  1422. labelsym:=p;
  1423. end;
  1424. constructor tgotonode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  1425. begin
  1426. inherited ppuload(t,ppufile);
  1427. labelnodeidx:=ppufile.getlongint;
  1428. exceptionblock:=ppufile.getbyte;
  1429. end;
  1430. procedure tgotonode.ppuwrite(ppufile:tcompilerppufile);
  1431. begin
  1432. inherited ppuwrite(ppufile);
  1433. labelnodeidx:=labelnode.ppuidx;
  1434. ppufile.putlongint(labelnodeidx);
  1435. ppufile.putbyte(exceptionblock);
  1436. end;
  1437. procedure tgotonode.buildderefimpl;
  1438. begin
  1439. inherited buildderefimpl;
  1440. end;
  1441. procedure tgotonode.derefimpl;
  1442. begin
  1443. inherited derefimpl;
  1444. end;
  1445. procedure tgotonode.resolveppuidx;
  1446. begin
  1447. labelnode:=tlabelnode(nodeppuidxget(labelnodeidx));
  1448. if labelnode.nodetype<>labeln then
  1449. internalerror(200809021);
  1450. end;
  1451. function tgotonode.pass_typecheck:tnode;
  1452. begin
  1453. result:=nil;
  1454. resultdef:=voidtype;
  1455. end;
  1456. function tgotonode.pass_1 : tnode;
  1457. begin
  1458. result:=nil;
  1459. expectloc:=LOC_VOID;
  1460. include(current_procinfo.flags,pi_has_goto);
  1461. { The labelnode can already be set when
  1462. this node was copied }
  1463. if not assigned(labelnode) then
  1464. begin
  1465. if assigned(labelsym.code) then
  1466. labelnode:=tlabelnode(labelsym.code)
  1467. else
  1468. CGMessage1(cg_e_goto_label_not_found,labelsym.realname);
  1469. end;
  1470. { check if we don't mess with exception blocks }
  1471. if assigned(labelnode) and
  1472. (exceptionblock<>labelnode.exceptionblock) then
  1473. CGMessage(cg_e_goto_inout_of_exception_block);
  1474. end;
  1475. function tgotonode.dogetcopy : tnode;
  1476. var
  1477. p : tgotonode;
  1478. begin
  1479. p:=tgotonode(inherited dogetcopy);
  1480. p.exceptionblock:=exceptionblock;
  1481. { generate labelnode if not done yet }
  1482. if not(assigned(labelnode)) then
  1483. begin
  1484. if assigned(labelsym) and assigned(labelsym.code) then
  1485. labelnode:=tlabelnode(labelsym.code)
  1486. end;
  1487. p.labelsym:=labelsym;
  1488. if assigned(labelnode) then
  1489. p.labelnode:=tlabelnode(labelnode.dogetcopy)
  1490. else
  1491. begin
  1492. { don't trigger IE when there was already an error, i.e. the
  1493. label is not defined. See tw11763 (PFV) }
  1494. if errorcount=0 then
  1495. internalerror(200610291);
  1496. end;
  1497. result:=p;
  1498. end;
  1499. function tgotonode.docompare(p: tnode): boolean;
  1500. begin
  1501. docompare := false;
  1502. end;
  1503. {*****************************************************************************
  1504. TLABELNODE
  1505. *****************************************************************************}
  1506. constructor tlabelnode.create(l:tnode;alabsym:tlabelsym);
  1507. begin
  1508. inherited create(labeln,l);
  1509. exceptionblock:=current_exceptblock;
  1510. labsym:=alabsym;
  1511. { Register labelnode in labelsym }
  1512. labsym.code:=self;
  1513. end;
  1514. constructor tlabelnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  1515. begin
  1516. inherited ppuload(t,ppufile);
  1517. exceptionblock:=ppufile.getbyte;
  1518. end;
  1519. destructor tlabelnode.destroy;
  1520. begin
  1521. { Remove reference in labelsym, this is to prevent
  1522. goto's to this label }
  1523. if assigned(labsym) and (labsym.code=pointer(self)) then
  1524. labsym.code:=nil;
  1525. inherited destroy;
  1526. end;
  1527. procedure tlabelnode.ppuwrite(ppufile:tcompilerppufile);
  1528. begin
  1529. inherited ppuwrite(ppufile);
  1530. ppufile.putbyte(exceptionblock);
  1531. end;
  1532. procedure tlabelnode.buildderefimpl;
  1533. begin
  1534. inherited buildderefimpl;
  1535. end;
  1536. procedure tlabelnode.derefimpl;
  1537. begin
  1538. inherited derefimpl;
  1539. end;
  1540. function tlabelnode.pass_typecheck:tnode;
  1541. begin
  1542. result:=nil;
  1543. { left could still be unassigned }
  1544. if assigned(left) then
  1545. typecheckpass(left);
  1546. resultdef:=voidtype;
  1547. end;
  1548. function tlabelnode.pass_1 : tnode;
  1549. begin
  1550. result:=nil;
  1551. expectloc:=LOC_VOID;
  1552. if assigned(left) then
  1553. firstpass(left);
  1554. end;
  1555. function tlabelnode.dogetcopy : tnode;
  1556. begin
  1557. if not(assigned(copiedto)) then
  1558. copiedto:=tlabelnode(inherited dogetcopy);
  1559. copiedto.exceptionblock:=exceptionblock;
  1560. result:=copiedto;
  1561. end;
  1562. function tlabelnode.docompare(p: tnode): boolean;
  1563. begin
  1564. docompare := false;
  1565. end;
  1566. {*****************************************************************************
  1567. TRAISENODE
  1568. *****************************************************************************}
  1569. constructor traisenode.create(l,taddr,tframe:tnode);
  1570. begin
  1571. inherited create(raisen,l,taddr,tframe);
  1572. end;
  1573. function traisenode.pass_typecheck:tnode;
  1574. begin
  1575. result:=nil;
  1576. resultdef:=voidtype;
  1577. if assigned(left) then
  1578. begin
  1579. { first para must be a _class_ }
  1580. typecheckpass(left);
  1581. set_varstate(left,vs_read,[vsf_must_be_valid]);
  1582. if codegenerror then
  1583. exit;
  1584. if not(is_class(left.resultdef)) then
  1585. CGMessage1(type_e_class_type_expected,left.resultdef.typename);
  1586. { insert needed typeconvs for addr,frame }
  1587. if assigned(right) then
  1588. begin
  1589. { addr }
  1590. typecheckpass(right);
  1591. inserttypeconv(right,voidpointertype);
  1592. { frame }
  1593. if assigned(third) then
  1594. begin
  1595. typecheckpass(third);
  1596. inserttypeconv(third,voidpointertype);
  1597. end;
  1598. end;
  1599. end;
  1600. end;
  1601. function traisenode.pass_1 : tnode;
  1602. begin
  1603. result:=nil;
  1604. include(current_procinfo.flags,pi_do_call);
  1605. expectloc:=LOC_VOID;
  1606. if assigned(left) then
  1607. begin
  1608. { first para must be a _class_ }
  1609. firstpass(left);
  1610. { insert needed typeconvs for addr,frame }
  1611. if assigned(right) then
  1612. begin
  1613. { addr }
  1614. firstpass(right);
  1615. { frame }
  1616. if assigned(third) then
  1617. firstpass(third);
  1618. end;
  1619. end;
  1620. end;
  1621. {*****************************************************************************
  1622. TTRYEXCEPTNODE
  1623. *****************************************************************************}
  1624. constructor ttryexceptnode.create(l,r,_t1 : tnode);
  1625. begin
  1626. inherited create(tryexceptn,l,r,_t1,nil);
  1627. end;
  1628. function ttryexceptnode.pass_typecheck:tnode;
  1629. begin
  1630. result:=nil;
  1631. typecheckpass(left);
  1632. { on statements }
  1633. if assigned(right) then
  1634. typecheckpass(right);
  1635. { else block }
  1636. if assigned(t1) then
  1637. typecheckpass(t1);
  1638. resultdef:=voidtype;
  1639. end;
  1640. function ttryexceptnode.pass_1 : tnode;
  1641. begin
  1642. result:=nil;
  1643. include(current_procinfo.flags,pi_do_call);
  1644. expectloc:=LOC_VOID;
  1645. firstpass(left);
  1646. { on statements }
  1647. if assigned(right) then
  1648. firstpass(right);
  1649. { else block }
  1650. if assigned(t1) then
  1651. firstpass(t1);
  1652. end;
  1653. {*****************************************************************************
  1654. TTRYFINALLYNODE
  1655. *****************************************************************************}
  1656. constructor ttryfinallynode.create(l,r:tnode);
  1657. begin
  1658. inherited create(tryfinallyn,l,r,nil,nil);
  1659. implicitframe:=false;
  1660. end;
  1661. constructor ttryfinallynode.create_implicit(l,r,_t1:tnode);
  1662. begin
  1663. inherited create(tryfinallyn,l,r,_t1,nil);
  1664. implicitframe:=true;
  1665. end;
  1666. function ttryfinallynode.pass_typecheck:tnode;
  1667. begin
  1668. result:=nil;
  1669. include(current_procinfo.flags,pi_do_call);
  1670. resultdef:=voidtype;
  1671. typecheckpass(left);
  1672. // "try block" is "used"? (JM)
  1673. set_varstate(left,vs_readwritten,[vsf_must_be_valid]);
  1674. typecheckpass(right);
  1675. // "except block" is "used"? (JM)
  1676. set_varstate(right,vs_readwritten,[vsf_must_be_valid]);
  1677. { special finally block only executed when there was an exception }
  1678. if assigned(t1) then
  1679. begin
  1680. typecheckpass(t1);
  1681. // "finally block" is "used"? (JM)
  1682. set_varstate(t1,vs_readwritten,[vsf_must_be_valid]);
  1683. end;
  1684. end;
  1685. function ttryfinallynode.pass_1 : tnode;
  1686. begin
  1687. result:=nil;
  1688. expectloc:=LOC_VOID;
  1689. firstpass(left);
  1690. firstpass(right);
  1691. if assigned(t1) then
  1692. firstpass(t1);
  1693. end;
  1694. function ttryfinallynode.simplify: tnode;
  1695. begin
  1696. result:=nil;
  1697. { if the try contains no code, we can kill
  1698. the try and except and return only the
  1699. finally part }
  1700. if has_no_code(left) then
  1701. begin
  1702. result:=right;
  1703. right:=nil;
  1704. end;
  1705. end;
  1706. {*****************************************************************************
  1707. TONNODE
  1708. *****************************************************************************}
  1709. constructor tonnode.create(l,r:tnode);
  1710. begin
  1711. inherited create(onn,l,r);
  1712. excepTSymtable:=nil;
  1713. excepttype:=nil;
  1714. end;
  1715. destructor tonnode.destroy;
  1716. begin
  1717. { copied nodes don't need to release the symtable }
  1718. if assigned(excepTSymtable) then
  1719. excepTSymtable.free;
  1720. inherited destroy;
  1721. end;
  1722. constructor tonnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  1723. begin
  1724. inherited ppuload(t,ppufile);
  1725. excepTSymtable:=nil;
  1726. excepttype:=nil;
  1727. end;
  1728. function tonnode.dogetcopy : tnode;
  1729. var
  1730. n : tonnode;
  1731. begin
  1732. n:=tonnode(inherited dogetcopy);
  1733. if assigned(exceptsymtable) then
  1734. n.exceptsymtable:=exceptsymtable.getcopy
  1735. else
  1736. n.exceptsymtable:=nil;
  1737. n.excepttype:=excepttype;
  1738. result:=n;
  1739. end;
  1740. function tonnode.pass_typecheck:tnode;
  1741. begin
  1742. result:=nil;
  1743. resultdef:=voidtype;
  1744. if not(is_class(excepttype)) then
  1745. CGMessage1(type_e_class_type_expected,excepttype.typename);
  1746. if assigned(left) then
  1747. typecheckpass(left);
  1748. if assigned(right) then
  1749. typecheckpass(right);
  1750. end;
  1751. function tonnode.pass_1 : tnode;
  1752. begin
  1753. result:=nil;
  1754. include(current_procinfo.flags,pi_do_call);
  1755. expectloc:=LOC_VOID;
  1756. if assigned(left) then
  1757. firstpass(left);
  1758. if assigned(right) then
  1759. firstpass(right);
  1760. end;
  1761. function tonnode.docompare(p: tnode): boolean;
  1762. begin
  1763. docompare := false;
  1764. end;
  1765. begin
  1766. cwhilerepeatnode:=twhilerepeatnode;
  1767. cifnode:=tifnode;
  1768. cfornode:=tfornode;
  1769. cexitnode:=texitnode;
  1770. cgotonode:=tgotonode;
  1771. clabelnode:=tlabelnode;
  1772. craisenode:=traisenode;
  1773. ctryexceptnode:=ttryexceptnode;
  1774. ctryfinallynode:=ttryfinallynode;
  1775. connode:=tonnode;
  1776. end.