nflw.pas 91 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603
  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. symconst,symtype,symbase,symdef,symsym,
  25. optloop;
  26. type
  27. { flags used by loop nodes }
  28. tloopflag = (
  29. { set if it is a for ... downto ... do loop }
  30. lnf_backward,
  31. { Do we need to parse childs to set var state? }
  32. lnf_varstate,
  33. { Do a test at the begin of the loop?}
  34. lnf_testatbegin,
  35. { Negate the loop test? }
  36. lnf_checknegate,
  37. { Should the value of the loop variable on exit be correct. }
  38. lnf_dont_mind_loopvar_on_exit,
  39. { Loop simplify flag }
  40. lnf_simplify_processing);
  41. tloopflags = set of tloopflag;
  42. const
  43. { loop flags which must match to consider loop nodes equal regarding the flags }
  44. loopflagsequal = [lnf_backward];
  45. type
  46. tlabelnode = class;
  47. tloopnode = class(tbinarynode)
  48. t1,t2 : tnode;
  49. loopflags : tloopflags;
  50. constructor create(tt : tnodetype;l,r,_t1,_t2 : tnode);virtual;
  51. destructor destroy;override;
  52. function dogetcopy : tnode;override;
  53. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  54. procedure ppuwrite(ppufile:tcompilerppufile);override;
  55. procedure buildderefimpl;override;
  56. procedure derefimpl;override;
  57. procedure insertintolist(l : tnodelist);override;
  58. procedure printnodetree(var t:text);override;
  59. {$ifdef DEBUG_NODE_XML}
  60. procedure XMLPrintNodeInfo(var T: Text); override;
  61. procedure XMLPrintNodeTree(var T: Text); override;
  62. {$endif DEBUG_NODE_XML}
  63. function docompare(p: tnode): boolean; override;
  64. end;
  65. twhilerepeatnode = class(tloopnode)
  66. { l: condition; r: body; tab: test at begin; cn: negate condition
  67. x,y,true,false: while loop
  68. x,y,false,true: repeat until loop }
  69. constructor create(l,r:Tnode;tab,cn:boolean);virtual;reintroduce;
  70. function pass_typecheck:tnode;override;
  71. function pass_1 : tnode;override;
  72. {$ifdef state_tracking}
  73. function track_state_pass(exec_known:boolean):boolean;override;
  74. {$endif}
  75. end;
  76. twhilerepeatnodeclass = class of twhilerepeatnode;
  77. tifnode = class(tloopnode)
  78. constructor create(l,r,_t1 : tnode);virtual;reintroduce;
  79. constructor create_internal(l,r,_t1 : tnode);virtual;reintroduce;
  80. function pass_typecheck:tnode;override;
  81. function pass_1 : tnode;override;
  82. function simplify(forinline : boolean) : tnode;override;
  83. private
  84. function internalsimplify(warn: boolean) : tnode;
  85. end;
  86. tifnodeclass = class of tifnode;
  87. tfornode = class(tloopnode)
  88. { if count isn divisable by unrolls then
  89. the for loop must jump to this label to get the correct
  90. number of executions }
  91. entrylabel,
  92. { this is a dummy node used by the dfa to store life information for the loop iteration }
  93. loopiteration : tnode;
  94. loopvar_notid:cardinal;
  95. constructor create(l,r,_t1,_t2 : tnode;back : boolean);virtual;reintroduce;
  96. function pass_typecheck:tnode;override;
  97. function pass_1 : tnode;override;
  98. function simplify(forinline : boolean) : tnode;override;
  99. end;
  100. tfornodeclass = class of tfornode;
  101. texitnode = class(tunarynode)
  102. constructor create(l:tnode);virtual;
  103. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  104. procedure ppuwrite(ppufile:tcompilerppufile);override;
  105. function pass_typecheck:tnode;override;
  106. function pass_1 : tnode;override;
  107. property resultexpr : tnode read left write left;
  108. end;
  109. texitnodeclass = class of texitnode;
  110. tbreaknode = class(tnode)
  111. constructor create;virtual;
  112. function pass_typecheck:tnode;override;
  113. function pass_1 : tnode;override;
  114. end;
  115. tbreaknodeclass = class of tbreaknode;
  116. tcontinuenode = class(tnode)
  117. constructor create;virtual;
  118. function pass_typecheck:tnode;override;
  119. function pass_1 : tnode;override;
  120. end;
  121. tcontinuenodeclass = class of tcontinuenode;
  122. tgotonode = class(tnode)
  123. private
  124. labelnodeidx : longint;
  125. public
  126. { * Set when creating the gotonode (since that's all we know at that
  127. point).
  128. * Used in pass_typecheck to find the corresponding labelnode (when a
  129. labelnode is created for a tlabelsym, the label assigns itself to
  130. the "code" field of the labelsym), which is then assigned to the
  131. labelnode field
  132. * After this, the labelsym is (and must) never be used anymore, and
  133. instead the labelnode must always be used. The reason is that the
  134. labelsym may not be owned by anything, and will be freed by the
  135. label node when it gets freed
  136. * The above is the reason why the labelsym field does not get copied
  137. by tgotonode.dogetcopy, but instead the copy of the labelnode gets
  138. tracked (both the labelnode and its goto nodes must always all be
  139. copied).
  140. The labelnode itself will not copy the labelsym either in dogetcopy.
  141. Instead, since the link between the gotos and the labels gets
  142. tracked via node tree references, the label node will generate a new
  143. asmlabel on the fly and the goto node will get it from there (if the
  144. goto node gets processed before the label node has been processed,
  145. it will ask the label node to generate the asmsymbol at that point).
  146. The original tlabelsym will get emitted only for the original
  147. label node. It is only actually used if there is a reference to it
  148. from
  149. * an inline assembly block. Since inline assembly blocks cannot be
  150. inlined at this point, it doesn't matter that this would break
  151. in case the node gets copied
  152. * global goto/label. Inlining is not supported for these, so no
  153. problem here either for now.
  154. * a load node (its symtableentry field). Since the symtableentry
  155. of loadnodes is always expected to be valid, we cannot do like
  156. with the goto nodes. Instead, we will create a new labelsym
  157. when performing a dogetcopy of such a load node and assign this
  158. labelsym to the copied labelnode (and vice versa)
  159. }
  160. labelsym : tlabelsym;
  161. labelnode : tlabelnode;
  162. exceptionblock : integer;
  163. constructor create(p : tlabelsym);virtual;
  164. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  165. procedure ppuwrite(ppufile:tcompilerppufile);override;
  166. procedure buildderefimpl;override;
  167. procedure derefimpl;override;
  168. procedure resolveppuidx;override;
  169. function dogetcopy : tnode;override;
  170. function pass_typecheck:tnode;override;
  171. function pass_1 : tnode;override;
  172. function docompare(p: tnode): boolean; override;
  173. end;
  174. tgotonodeclass = class of tgotonode;
  175. tlabelnode = class(tunarynode)
  176. exceptionblock : integer;
  177. { when copying trees, this points to the newly created copy of a label }
  178. copiedto : tlabelnode;
  179. labsym : tlabelsym;
  180. constructor create(l:tnode;alabsym:tlabelsym);virtual;
  181. destructor destroy;override;
  182. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  183. procedure ppuwrite(ppufile:tcompilerppufile);override;
  184. procedure buildderefimpl;override;
  185. procedure derefimpl;override;
  186. function dogetcopy : tnode;override;
  187. function pass_typecheck:tnode;override;
  188. function pass_1 : tnode;override;
  189. function docompare(p: tnode): boolean; override;
  190. end;
  191. tlabelnodeclass = class of tlabelnode;
  192. traisenode = class(ttertiarynode)
  193. constructor create(l,taddr,tframe:tnode);virtual;
  194. function pass_typecheck:tnode;override;
  195. function pass_1 : tnode;override;
  196. end;
  197. traisenodeclass = class of traisenode;
  198. ttryexceptnode = class(tloopnode)
  199. constructor create(l,r,_t1 : tnode);virtual;reintroduce;
  200. function pass_typecheck:tnode;override;
  201. function pass_1 : tnode;override;
  202. function simplify(forinline: boolean): tnode; override;
  203. protected
  204. procedure adjust_estimated_stack_size; virtual;
  205. end;
  206. ttryexceptnodeclass = class of ttryexceptnode;
  207. { the third node is to store a copy of the finally code for llvm:
  208. it needs one copy to execute in case an exception occurs, and
  209. one in case no exception occurs }
  210. ttryfinallynode = class(ttertiarynode)
  211. implicitframe : boolean;
  212. constructor create(l,r:tnode);virtual;reintroduce;
  213. constructor create_implicit(l,r:tnode);virtual;
  214. function pass_typecheck:tnode;override;
  215. function pass_1 : tnode;override;
  216. function simplify(forinline:boolean): tnode;override;
  217. protected
  218. procedure adjust_estimated_stack_size; virtual;
  219. end;
  220. ttryfinallynodeclass = class of ttryfinallynode;
  221. tonnode = class(tbinarynode)
  222. excepTSymtable : TSymtable;
  223. excepttype : tobjectdef;
  224. constructor create(l,r:tnode);virtual;
  225. destructor destroy;override;
  226. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  227. function pass_typecheck:tnode;override;
  228. function pass_1 : tnode;override;
  229. function dogetcopy : tnode;override;
  230. function docompare(p: tnode): boolean; override;
  231. end;
  232. tonnodeclass = class of tonnode;
  233. var
  234. cwhilerepeatnode : twhilerepeatnodeclass=twhilerepeatnode;
  235. cifnode : tifnodeclass = tifnode;
  236. cfornode : tfornodeclass = tfornode;
  237. cexitnode : texitnodeclass = texitnode;
  238. cgotonode : tgotonodeclass = tgotonode;
  239. clabelnode : tlabelnodeclass = tlabelnode;
  240. craisenode : traisenodeclass = traisenode;
  241. ctryexceptnode : ttryexceptnodeclass = ttryexceptnode;
  242. ctryfinallynode : ttryfinallynodeclass = ttryfinallynode;
  243. connode : tonnodeclass = tonnode;
  244. cbreaknode : tbreaknodeclass = tbreaknode;
  245. ccontinuenode : tcontinuenodeclass = tcontinuenode;
  246. // for-in loop helpers
  247. function create_type_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  248. function create_string_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  249. function create_array_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  250. function create_set_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  251. function create_enumerator_for_in_loop(hloopvar, hloopbody, expr: tnode;
  252. enumerator_get, enumerator_move: tprocdef; enumerator_current: tpropertysym): tnode;
  253. function create_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  254. implementation
  255. uses
  256. globtype,systems,constexp,compinnr,
  257. cutils,verbose,globals,ppu,
  258. symtable,paramgr,defcmp,defutil,htypechk,pass_1,
  259. ncal,nadd,ncon,nmem,nld,ncnv,nbas,nutils,ninl,nset,ngenutil,
  260. {$ifdef state_tracking}
  261. nstate,
  262. {$endif}
  263. {$ifdef i8086}
  264. cpuinfo,
  265. {$endif i8086}
  266. cgbase,procinfo
  267. ;
  268. // for-in loop helpers
  269. function create_type_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  270. begin
  271. result:=cfornode.create(hloopvar,
  272. cinlinenode.create(in_low_x,false,expr.getcopy),
  273. cinlinenode.create(in_high_x,false,expr.getcopy),
  274. hloopbody,
  275. false);
  276. end;
  277. function create_objc_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  278. var
  279. mainstatement, outerloopbodystatement, innerloopbodystatement, tempstatement: tstatementnode;
  280. state, mutationcheck, currentamount, innerloopcounter, items, expressiontemp: ttempcreatenode;
  281. outerloop, innerloop, hp: tnode;
  282. itemsarraydef: tarraydef;
  283. sym: tsym;
  284. begin
  285. { Objective-C enumerators require Objective-C 2.0 }
  286. if not(m_objectivec2 in current_settings.modeswitches) then
  287. begin
  288. result:=cerrornode.create;
  289. MessagePos(expr.fileinfo,parser_e_objc_enumerator_2_0);
  290. exit;
  291. end;
  292. { Requires the NSFastEnumeration protocol and NSFastEnumerationState
  293. record }
  294. maybeloadcocoatypes;
  295. if not assigned(objc_fastenumeration) or
  296. not assigned(objc_fastenumerationstate) then
  297. begin
  298. result:=cerrornode.create;
  299. MessagePos(expr.fileinfo,parser_e_objc_missing_enumeration_defs);
  300. exit;
  301. end;
  302. (* Original code:
  303. for hloopvar in expression do
  304. <hloopbody>
  305. Pascal code equivalent into which it has to be transformed
  306. (sure would be nice if the compiler had some kind of templates ;) :
  307. var
  308. state: NSFastEnumerationState;
  309. expressiontemp: NSFastEnumerationProtocol;
  310. mutationcheck,
  311. currentamount,
  312. innerloopcounter: culong;
  313. { size can be increased/decreased if desired }
  314. items: array[1..16] of id;
  315. begin
  316. fillchar(state,sizeof(state),0);
  317. expressiontemp:=expression;
  318. repeat
  319. currentamount:=expressiontemp.countByEnumeratingWithState_objects_count(@state,@items,length(items));
  320. if currentamount=0 then
  321. begin
  322. { "The iterating variable is set to nil when the loop ends by
  323. exhausting the source pool of objects" }
  324. hloopvar:=nil;
  325. break;
  326. end;
  327. mutationcheck:=state.mutationsptr^;
  328. innerloopcounter:=culong(-1);
  329. repeat
  330. { at the start so that "continue" in <loopbody> works correctly }
  331. { don't use for-loop, because then the value of the iteration
  332. counter is undefined on exit and we have to check it in the
  333. outer repeat/until condition }
  334. {$push}
  335. {$r-,q-}
  336. inc(innerloopcounter);
  337. {$pop}
  338. if innerloopcounter=currentamount then
  339. break;
  340. if mutationcheck<>state.mutationsptr^ then
  341. { raises Objective-C exception... }
  342. objc_enumerationMutation(expressiontemp);
  343. hloopvar:=state.itemsPtr[innerloopcounter];
  344. { if continue in loopbody -> jumps to start, increases count and checks }
  345. { if break in loopbody: goes to outer repeat/until and innerloopcount
  346. will be < currentamount -> stops }
  347. <hloopbody>
  348. until false;
  349. { if the inner loop terminated early, "break" was used and we have
  350. to stop }
  351. { "If the loop is terminated early, the iterating variable is left
  352. pointing to the last iteration item." }
  353. until innerloopcounter<currentamount;
  354. end;
  355. *)
  356. result:=internalstatements(mainstatement);
  357. { the fast enumeration state }
  358. state:=ctempcreatenode.create(objc_fastenumerationstate,objc_fastenumerationstate.size,tt_persistent,false);
  359. typecheckpass(tnode(state));
  360. addstatement(mainstatement,state);
  361. { the temporary items array }
  362. itemsarraydef:=carraydef.create(1,16,u32inttype);
  363. itemsarraydef.elementdef:=objc_idtype;
  364. items:=ctempcreatenode.create(itemsarraydef,itemsarraydef.size,tt_persistent,false);
  365. addstatement(mainstatement,items);
  366. typecheckpass(tnode(items));
  367. { temp for the expression/collection through which we iterate }
  368. expressiontemp:=ctempcreatenode.create(objc_fastenumeration,objc_fastenumeration.size,tt_persistent,true);
  369. addstatement(mainstatement,expressiontemp);
  370. { currentamount temp (not really clean: we use ptruint instead of
  371. culong) }
  372. currentamount:=ctempcreatenode.create(ptruinttype,ptruinttype.size,tt_persistent,true);
  373. typecheckpass(tnode(currentamount));
  374. addstatement(mainstatement,currentamount);
  375. { mutationcheck temp (idem) }
  376. mutationcheck:=ctempcreatenode.create(ptruinttype,ptruinttype.size,tt_persistent,true);
  377. typecheckpass(tnode(mutationcheck));
  378. addstatement(mainstatement,mutationcheck);
  379. { innerloopcounter temp (idem) }
  380. innerloopcounter:=ctempcreatenode.create(ptruinttype,ptruinttype.size,tt_persistent,true);
  381. typecheckpass(tnode(innerloopcounter));
  382. addstatement(mainstatement,innerloopcounter);
  383. { initialise the state with 0 }
  384. addstatement(mainstatement,ccallnode.createinternfromunit('SYSTEM','FILLCHAR',
  385. ccallparanode.create(genintconstnode(0),
  386. ccallparanode.create(genintconstnode(objc_fastenumerationstate.size),
  387. ccallparanode.create(ctemprefnode.create(state),nil)
  388. )
  389. )
  390. ));
  391. { this will also check whether the expression (potentially) conforms
  392. to the NSFastEnumeration protocol (use expr.getcopy, because the
  393. caller will free expr) }
  394. addstatement(mainstatement,cassignmentnode.create(ctemprefnode.create(expressiontemp),expr.getcopy));
  395. { we add the "repeat..until" afterwards, now just create the body }
  396. outerloop:=internalstatements(outerloopbodystatement);
  397. { the countByEnumeratingWithState_objects_count call }
  398. hp:=ccallparanode.create(cinlinenode.create(in_length_x,false,ctypenode.create(itemsarraydef)),
  399. ccallparanode.create(caddrnode.create(ctemprefnode.create(items)),
  400. ccallparanode.create(caddrnode.create(ctemprefnode.create(state)),nil)
  401. )
  402. );
  403. sym:=search_struct_member(objc_fastenumeration,'COUNTBYENUMERATINGWITHSTATE_OBJECTS_COUNT');
  404. if not assigned(sym) or
  405. (sym.typ<>procsym) then
  406. internalerror(2010061901);
  407. hp:=ccallnode.create(hp,tprocsym(sym),sym.owner,ctemprefnode.create(expressiontemp),[],nil);
  408. addstatement(outerloopbodystatement,cassignmentnode.create(
  409. ctemprefnode.create(currentamount),hp));
  410. { if currentamount = 0, bail out (use copy of hloopvar, because we
  411. have to use it again below) }
  412. hp:=internalstatements(tempstatement);
  413. addstatement(tempstatement,cassignmentnode.create(
  414. hloopvar.getcopy,cnilnode.create));
  415. addstatement(tempstatement,cbreaknode.create);
  416. addstatement(outerloopbodystatement,cifnode.create(
  417. caddnode.create(equaln,ctemprefnode.create(currentamount),genintconstnode(0)),
  418. hp,nil));
  419. { initial value of mutationcheck }
  420. hp:=ctemprefnode.create(state);
  421. typecheckpass(hp);
  422. hp:=cderefnode.create(genloadfield(hp,'MUTATIONSPTR'));
  423. addstatement(outerloopbodystatement,cassignmentnode.create(
  424. ctemprefnode.create(mutationcheck),hp));
  425. { initialise innerloopcounter }
  426. addstatement(outerloopbodystatement,cassignmentnode.create(
  427. ctemprefnode.create(innerloopcounter),cordconstnode.create(-1,ptruinttype,false)));
  428. { and now the inner loop, again adding the repeat/until afterwards }
  429. innerloop:=internalstatements(innerloopbodystatement);
  430. { inc(innerloopcounter) without range/overflowchecking (because
  431. we go from culong(-1) to 0 during the first iteration }
  432. hp:=cinlinenode.create(
  433. in_inc_x,false,ccallparanode.create(
  434. ctemprefnode.create(innerloopcounter),nil));
  435. hp.localswitches:=hp.localswitches-[cs_check_range,cs_check_overflow];
  436. addstatement(innerloopbodystatement,hp);
  437. { if innerloopcounter=currentamount then break to the outer loop }
  438. addstatement(innerloopbodystatement,cifnode.create(
  439. caddnode.create(equaln,
  440. ctemprefnode.create(innerloopcounter),
  441. ctemprefnode.create(currentamount)),
  442. cbreaknode.create,
  443. nil));
  444. { verify that the collection didn't change in the mean time }
  445. hp:=ctemprefnode.create(state);
  446. typecheckpass(hp);
  447. addstatement(innerloopbodystatement,cifnode.create(
  448. caddnode.create(unequaln,
  449. ctemprefnode.create(mutationcheck),
  450. cderefnode.create(genloadfield(hp,'MUTATIONSPTR'))
  451. ),
  452. ccallnode.createinternfromunit('OBJC','OBJC_ENUMERATIONMUTATION',
  453. ccallparanode.create(ctemprefnode.create(expressiontemp),nil)),
  454. nil));
  455. { finally: actually get the next element }
  456. hp:=ctemprefnode.create(state);
  457. typecheckpass(hp);
  458. hp:=genloadfield(hp,'ITEMSPTR');
  459. typecheckpass(hp);
  460. { don't simply use a vecn, because indexing a pointer won't work in
  461. non-FPC modes }
  462. if hp.resultdef.typ<>pointerdef then
  463. internalerror(2010061904);
  464. inserttypeconv(hp,
  465. carraydef.create_from_pointer(tpointerdef(hp.resultdef)));
  466. hp:=cvecnode.create(hp,ctemprefnode.create(innerloopcounter));
  467. addstatement(innerloopbodystatement,
  468. cassignmentnode.create(hloopvar,hp));
  469. { the actual loop body! }
  470. addstatement(innerloopbodystatement,hloopbody);
  471. { create the inner repeat/until and add it to the body of the outer
  472. one }
  473. hp:=cwhilerepeatnode.create(
  474. { repeat .. until false }
  475. cordconstnode.create(0,pasbool1type,false),innerloop,false,true);
  476. addstatement(outerloopbodystatement,hp);
  477. { create the outer repeat/until and add it to the the main body }
  478. hp:=cwhilerepeatnode.create(
  479. { repeat .. until innerloopcounter<currentamount }
  480. caddnode.create(ltn,
  481. ctemprefnode.create(innerloopcounter),
  482. ctemprefnode.create(currentamount)),
  483. outerloop,false,true);
  484. addstatement(mainstatement,hp);
  485. { release the temps }
  486. addstatement(mainstatement,ctempdeletenode.create(state));
  487. addstatement(mainstatement,ctempdeletenode.create(mutationcheck));
  488. addstatement(mainstatement,ctempdeletenode.create(currentamount));
  489. addstatement(mainstatement,ctempdeletenode.create(innerloopcounter));
  490. addstatement(mainstatement,ctempdeletenode.create(items));
  491. addstatement(mainstatement,ctempdeletenode.create(expressiontemp));
  492. end;
  493. function create_string_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  494. var
  495. loopstatement, loopbodystatement: tstatementnode;
  496. loopvar, stringvar: ttempcreatenode;
  497. stringindex, loopbody, forloopnode: tnode;
  498. begin
  499. { result is a block of statements }
  500. result:=internalstatements(loopstatement);
  501. { create a temp variable for expression }
  502. stringvar := ctempcreatenode.create(
  503. expr.resultdef,
  504. expr.resultdef.size,
  505. tt_persistent,true);
  506. addstatement(loopstatement,stringvar);
  507. addstatement(loopstatement,cassignmentnode.create(ctemprefnode.create(stringvar),expr.getcopy));
  508. { create a loop counter: signed integer with size of string length }
  509. loopvar := ctempcreatenode.create(
  510. sinttype,
  511. sinttype.size,
  512. tt_persistent,true);
  513. addstatement(loopstatement,loopvar);
  514. stringindex:=ctemprefnode.create(loopvar);
  515. loopbody:=internalstatements(loopbodystatement);
  516. // for-in loop variable := string_expression[index]
  517. addstatement(loopbodystatement,
  518. cassignmentnode.create(hloopvar, cvecnode.create(ctemprefnode.create(stringvar),stringindex)));
  519. { add the actual statement to the loop }
  520. addstatement(loopbodystatement,hloopbody);
  521. forloopnode:=cfornode.create(ctemprefnode.create(loopvar),
  522. genintconstnode(1),
  523. cinlinenode.create(in_length_x,false,ctemprefnode.create(stringvar)),
  524. loopbody,
  525. false);
  526. addstatement(loopstatement,forloopnode);
  527. { free the loop counter }
  528. addstatement(loopstatement,ctempdeletenode.create(loopvar));
  529. { free the temp variable for expression }
  530. addstatement(loopstatement,ctempdeletenode.create(stringvar));
  531. end;
  532. function create_array_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  533. var
  534. loopstatement, loopbodystatement: tstatementnode;
  535. loopvar, arrayvar: ttempcreatenode;
  536. arrayindex, lowbound, highbound, loopbody, forloopnode, expression: tnode;
  537. is_string: boolean;
  538. tmpdef, convertdef: tdef;
  539. elementcount: aword;
  540. begin
  541. expression := expr;
  542. { result is a block of statements }
  543. result:=internalstatements(loopstatement);
  544. is_string:=ado_IsConstString in tarraydef(expr.resultdef).arrayoptions;
  545. // if array element type <> loovar type then create a conversion if possible
  546. if compare_defs(tarraydef(expression.resultdef).elementdef,hloopvar.resultdef,nothingn)=te_incompatible then
  547. begin
  548. tmpdef:=expression.resultdef;
  549. elementcount:=1;
  550. while assigned(tmpdef) and (tmpdef.typ=arraydef) and
  551. (tarraydef(tmpdef).arrayoptions = []) and
  552. (compare_defs(tarraydef(tmpdef).elementdef,hloopvar.resultdef,nothingn)=te_incompatible) do
  553. begin
  554. elementcount:=elementcount*tarraydef(tmpdef).elecount;
  555. tmpdef:=tarraydef(tmpdef).elementdef;
  556. end;
  557. if assigned(tmpdef) and (tmpdef.typ=arraydef) and (tarraydef(tmpdef).arrayoptions = []) then
  558. begin
  559. elementcount:=elementcount*tarraydef(tmpdef).elecount;
  560. convertdef:=carraydef.create(0,elementcount-1,s32inttype);
  561. tarraydef(convertdef).elementdef:=tarraydef(tmpdef).elementdef;
  562. expression:=expr.getcopy;
  563. expression:=ctypeconvnode.create_internal(expression,convertdef);
  564. typecheckpass(expression);
  565. addstatement(loopstatement,expression);
  566. end;
  567. end;
  568. if (node_complexity(expression) > 1) and
  569. not(is_open_array(expression.resultdef)) and not(is_array_of_const(expression.resultdef)) then
  570. begin
  571. { create a temp variable for expression }
  572. arrayvar := ctempcreatenode.create(
  573. expression.resultdef,
  574. expression.resultdef.size,
  575. tt_persistent,true);
  576. if is_string then
  577. begin
  578. lowbound:=genintconstnode(1);
  579. highbound:=cinlinenode.create(in_length_x,false,ctemprefnode.create(arrayvar))
  580. end
  581. else
  582. begin
  583. lowbound:=cinlinenode.create(in_low_x,false,ctemprefnode.create(arrayvar));
  584. highbound:=cinlinenode.create(in_high_x,false,ctemprefnode.create(arrayvar));
  585. end;
  586. addstatement(loopstatement,arrayvar);
  587. addstatement(loopstatement,cassignmentnode.create(ctemprefnode.create(arrayvar),expression.getcopy));
  588. end
  589. else
  590. begin
  591. arrayvar:=nil;
  592. if is_string then
  593. begin
  594. lowbound:=genintconstnode(1);
  595. highbound:=cinlinenode.create(in_length_x,false,expression.getcopy);
  596. end
  597. else
  598. begin
  599. lowbound:=cinlinenode.create(in_low_x,false,expression.getcopy);
  600. highbound:=cinlinenode.create(in_high_x,false,expression.getcopy);
  601. end;
  602. end;
  603. { create a loop counter }
  604. loopvar := ctempcreatenode.create(
  605. tarraydef(expression.resultdef).rangedef,
  606. tarraydef(expression.resultdef).rangedef.size,
  607. tt_persistent,true);
  608. addstatement(loopstatement,loopvar);
  609. arrayindex:=ctemprefnode.create(loopvar);
  610. loopbody:=internalstatements(loopbodystatement);
  611. // for-in loop variable := array_expression[index]
  612. if assigned(arrayvar) then
  613. addstatement(loopbodystatement,
  614. cassignmentnode.create(hloopvar,cvecnode.create(ctemprefnode.create(arrayvar),arrayindex)))
  615. else
  616. addstatement(loopbodystatement,
  617. cassignmentnode.create(hloopvar,cvecnode.create(expression.getcopy,arrayindex)));
  618. { add the actual statement to the loop }
  619. addstatement(loopbodystatement,hloopbody);
  620. forloopnode:=cfornode.create(ctemprefnode.create(loopvar),
  621. lowbound,
  622. highbound,
  623. loopbody,
  624. false);
  625. addstatement(loopstatement,forloopnode);
  626. { free the loop counter }
  627. addstatement(loopstatement,ctempdeletenode.create(loopvar));
  628. { free the temp variable for expression if needed }
  629. if arrayvar<>nil then
  630. addstatement(loopstatement,ctempdeletenode.create(arrayvar));
  631. end;
  632. function create_set_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  633. var
  634. loopstatement, loopbodystatement: tstatementnode;
  635. loopvar, setvar: ttempcreatenode;
  636. loopbody, forloopnode: tnode;
  637. begin
  638. // first check is set is empty and if it so then skip other processing
  639. if not Assigned(tsetdef(expr.resultdef).elementdef) then
  640. begin
  641. result:=cnothingnode.create;
  642. // free unused nodes
  643. hloopvar.free;
  644. hloopbody.free;
  645. exit;
  646. end;
  647. { result is a block of statements }
  648. result:=internalstatements(loopstatement);
  649. { create a temp variable for expression }
  650. setvar := ctempcreatenode.create(
  651. expr.resultdef,
  652. expr.resultdef.size,
  653. tt_persistent,true);
  654. addstatement(loopstatement,setvar);
  655. addstatement(loopstatement,cassignmentnode.create(ctemprefnode.create(setvar),expr.getcopy));
  656. { create a loop counter }
  657. loopvar := ctempcreatenode.create(
  658. tsetdef(expr.resultdef).elementdef,
  659. tsetdef(expr.resultdef).elementdef.size,
  660. tt_persistent,true);
  661. addstatement(loopstatement,loopvar);
  662. // if loopvar in set then
  663. // begin
  664. // hloopvar := loopvar
  665. // for-in loop body
  666. // end
  667. loopbody:=cifnode.create(
  668. cinnode.create(ctemprefnode.create(loopvar),ctemprefnode.create(setvar)),
  669. internalstatements(loopbodystatement),
  670. nil);
  671. addstatement(loopbodystatement,cassignmentnode.create(hloopvar,ctemprefnode.create(loopvar)));
  672. { add the actual statement to the loop }
  673. addstatement(loopbodystatement,hloopbody);
  674. forloopnode:=cfornode.create(ctemprefnode.create(loopvar),
  675. cinlinenode.create(in_low_x,false,ctemprefnode.create(setvar)),
  676. cinlinenode.create(in_high_x,false,ctemprefnode.create(setvar)),
  677. loopbody,
  678. false);
  679. addstatement(loopstatement,forloopnode);
  680. { free the loop counter }
  681. addstatement(loopstatement,ctempdeletenode.create(loopvar));
  682. { free the temp variable for expression }
  683. addstatement(loopstatement,ctempdeletenode.create(setvar));
  684. end;
  685. function create_enumerator_for_in_loop(hloopvar, hloopbody, expr: tnode;
  686. enumerator_get, enumerator_move: tprocdef; enumerator_current: tpropertysym): tnode;
  687. var
  688. loopstatement, loopbodystatement: tstatementnode;
  689. enumvar: ttempcreatenode;
  690. loopbody, whileloopnode,
  691. enum_get, enum_move, enum_current, enum_get_params: tnode;
  692. propaccesslist: tpropaccesslist;
  693. enumerator_is_class: boolean;
  694. enumerator_destructor: tprocdef;
  695. begin
  696. { result is a block of statements }
  697. result:=internalstatements(loopstatement);
  698. enumerator_is_class := is_class(enumerator_get.returndef);
  699. { create a temp variable for enumerator }
  700. enumvar := ctempcreatenode.create(
  701. enumerator_get.returndef,
  702. enumerator_get.returndef.size,
  703. tt_persistent,true);
  704. addstatement(loopstatement,enumvar);
  705. if enumerator_get.proctypeoption=potype_operator then
  706. begin
  707. enum_get_params:=ccallparanode.create(expr.getcopy,nil);
  708. enum_get:=ccallnode.create(enum_get_params, tprocsym(enumerator_get.procsym), nil, nil, [],nil);
  709. tcallnode(enum_get).procdefinition:=enumerator_get;
  710. addsymref(enumerator_get.procsym,enumerator_get);
  711. end
  712. else
  713. enum_get:=ccallnode.create(nil, tprocsym(enumerator_get.procsym), enumerator_get.owner, expr.getcopy, [],nil);
  714. addstatement(loopstatement,
  715. cassignmentnode.create(
  716. ctemprefnode.create(enumvar),
  717. enum_get
  718. ));
  719. loopbody:=internalstatements(loopbodystatement);
  720. { for-in loop variable := enumerator.current }
  721. if enumerator_current.getpropaccesslist(palt_read,propaccesslist) then
  722. begin
  723. case propaccesslist.firstsym^.sym.typ of
  724. fieldvarsym :
  725. begin
  726. { generate access code }
  727. enum_current:=ctemprefnode.create(enumvar);
  728. propaccesslist_to_node(enum_current,enumerator_current.owner,propaccesslist);
  729. include(enum_current.flags,nf_isproperty);
  730. end;
  731. procsym :
  732. begin
  733. { generate the method call }
  734. enum_current:=ccallnode.create(nil,tprocsym(propaccesslist.firstsym^.sym),enumerator_current.owner,ctemprefnode.create(enumvar),[],nil);
  735. include(enum_current.flags,nf_isproperty);
  736. end
  737. else
  738. begin
  739. enum_current:=cerrornode.create;
  740. Message(type_e_mismatch);
  741. end;
  742. end;
  743. end
  744. else
  745. enum_current:=cerrornode.create;
  746. addstatement(loopbodystatement,
  747. cassignmentnode.create(hloopvar, enum_current));
  748. { add the actual statement to the loop }
  749. addstatement(loopbodystatement,hloopbody);
  750. enum_move:=ccallnode.create(nil, tprocsym(enumerator_move.procsym), enumerator_move.owner, ctemprefnode.create(enumvar), [],nil);
  751. whileloopnode:=cwhilerepeatnode.create(enum_move,loopbody,true,false);
  752. if enumerator_is_class then
  753. begin
  754. { insert a try-finally and call the destructor for the enumerator in the finally section }
  755. enumerator_destructor:=tobjectdef(enumerator_get.returndef).find_destructor;
  756. if assigned(enumerator_destructor) then
  757. begin
  758. whileloopnode:=ctryfinallynode.create(
  759. whileloopnode, // try node
  760. ccallnode.create(nil,tprocsym(enumerator_destructor.procsym), // finally node
  761. enumerator_destructor.procsym.owner,ctemprefnode.create(enumvar),[],nil));
  762. end;
  763. { if getenumerator <> nil then do the loop }
  764. whileloopnode:=cifnode.create(
  765. caddnode.create(unequaln, ctemprefnode.create(enumvar), cnilnode.create),
  766. whileloopnode,
  767. nil);
  768. end;
  769. addstatement(loopstatement, whileloopnode);
  770. if is_object(enumerator_get.returndef) then
  771. begin
  772. // call the object destructor too
  773. enumerator_destructor:=tobjectdef(enumerator_get.returndef).find_destructor;
  774. if assigned(enumerator_destructor) then
  775. begin
  776. addstatement(loopstatement,
  777. ccallnode.create(nil,tprocsym(enumerator_destructor.procsym),
  778. enumerator_destructor.procsym.owner,ctemprefnode.create(enumvar),[],nil));
  779. end;
  780. end;
  781. { free the temp variable for enumerator }
  782. addstatement(loopstatement,ctempdeletenode.create(enumvar));
  783. end;
  784. function create_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  785. var
  786. pd, movenext: tprocdef;
  787. helperdef: tobjectdef;
  788. current: tpropertysym;
  789. storefilepos: tfileposinfo;
  790. begin
  791. storefilepos:=current_filepos;
  792. current_filepos:=hloopvar.fileinfo;
  793. if expr.nodetype=typen then
  794. begin
  795. if (expr.resultdef.typ=enumdef) and tenumdef(expr.resultdef).has_jumps then
  796. begin
  797. result:=cerrornode.create;
  798. hloopvar.free;
  799. hloopbody.free;
  800. MessagePos1(expr.fileinfo,parser_e_for_in_loop_cannot_be_used_for_the_type,expr.resultdef.typename);
  801. end
  802. else
  803. result:=create_type_for_in_loop(hloopvar, hloopbody, expr);
  804. end
  805. else
  806. begin
  807. { loop is made for an expression }
  808. // Objective-C uses different conventions (and it's only supported for Objective-C 2.0)
  809. if is_objc_class_or_protocol(hloopvar.resultdef) or
  810. is_objc_class_or_protocol(expr.resultdef) then
  811. begin
  812. result:=create_objc_for_in_loop(hloopvar,hloopbody,expr);
  813. if result.nodetype=errorn then
  814. begin
  815. hloopvar.free;
  816. hloopbody.free;
  817. end;
  818. end
  819. { "for x in [] do ..." always results in a never executed loop body }
  820. else if (is_array_constructor(expr.resultdef) and
  821. (tarraydef(expr.resultdef).elementdef=voidtype)) then
  822. begin
  823. if assigned(hloopbody) then
  824. MessagePos(hloopbody.fileinfo,cg_w_unreachable_code);
  825. result:=cnothingnode.create;
  826. end
  827. else
  828. begin
  829. // search for operator first
  830. pd:=search_enumerator_operator(expr.resultdef, hloopvar.resultdef);
  831. // if there is no operator then search for class/object enumerator method
  832. if (pd=nil) and (expr.resultdef.typ in [objectdef,recorddef]) then
  833. begin
  834. { first search using the helper hierarchy }
  835. if search_last_objectpascal_helper(tabstractrecorddef(expr.resultdef),nil,helperdef) then
  836. repeat
  837. pd:=helperdef.search_enumerator_get;
  838. helperdef:=helperdef.childof;
  839. until (pd<>nil) or (helperdef=nil);
  840. { we didn't find an enumerator in a helper, so search in the
  841. class/record/object itself }
  842. if pd=nil then
  843. pd:=tabstractrecorddef(expr.resultdef).search_enumerator_get;
  844. end;
  845. if pd<>nil then
  846. begin
  847. // seach movenext and current symbols
  848. movenext:=tabstractrecorddef(pd.returndef).search_enumerator_move;
  849. if movenext = nil then
  850. begin
  851. result:=cerrornode.create;
  852. hloopvar.free;
  853. hloopbody.free;
  854. MessagePos1(expr.fileinfo,sym_e_no_enumerator_move,pd.returndef.typename);
  855. end
  856. else
  857. begin
  858. current:=tpropertysym(tabstractrecorddef(pd.returndef).search_enumerator_current);
  859. if current = nil then
  860. begin
  861. result:=cerrornode.create;
  862. hloopvar.free;
  863. hloopbody.free;
  864. MessagePos1(expr.fileinfo,sym_e_no_enumerator_current,pd.returndef.typename);
  865. end
  866. else
  867. result:=create_enumerator_for_in_loop(hloopvar, hloopbody, expr, pd, movenext, current);
  868. end;
  869. end
  870. else
  871. begin
  872. { prefer set if loop var could be a set var and the loop
  873. expression can indeed be a set }
  874. if (expr.nodetype=arrayconstructorn) and
  875. (hloopvar.resultdef.typ in [enumdef,orddef]) and
  876. arrayconstructor_can_be_set(expr) then
  877. begin
  878. expr:=arrayconstructor_to_set(expr,false);
  879. typecheckpass(expr);
  880. end;
  881. case expr.resultdef.typ of
  882. stringdef: result:=create_string_for_in_loop(hloopvar, hloopbody, expr);
  883. arraydef: result:=create_array_for_in_loop(hloopvar, hloopbody, expr);
  884. setdef: result:=create_set_for_in_loop(hloopvar, hloopbody, expr);
  885. else
  886. begin
  887. result:=cerrornode.create;
  888. hloopvar.free;
  889. hloopbody.free;
  890. MessagePos1(expr.fileinfo,sym_e_no_enumerator,expr.resultdef.typename);
  891. end;
  892. end;
  893. end;
  894. end;
  895. end;
  896. current_filepos:=storefilepos;
  897. end;
  898. {****************************************************************************
  899. TLOOPNODE
  900. *****************************************************************************}
  901. constructor tloopnode.create(tt : tnodetype;l,r,_t1,_t2 : tnode);
  902. begin
  903. inherited create(tt,l,r);
  904. t1:=_t1;
  905. t2:=_t2;
  906. fileinfo:=l.fileinfo;
  907. end;
  908. destructor tloopnode.destroy;
  909. begin
  910. t1.free;
  911. t2.free;
  912. inherited destroy;
  913. end;
  914. constructor tloopnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  915. begin
  916. inherited ppuload(t,ppufile);
  917. t1:=ppuloadnode(ppufile);
  918. t2:=ppuloadnode(ppufile);
  919. ppufile.getset(tppuset1(loopflags));
  920. end;
  921. procedure tloopnode.ppuwrite(ppufile:tcompilerppufile);
  922. begin
  923. inherited ppuwrite(ppufile);
  924. ppuwritenode(ppufile,t1);
  925. ppuwritenode(ppufile,t2);
  926. ppufile.putset(tppuset1(loopflags));
  927. end;
  928. procedure tloopnode.buildderefimpl;
  929. begin
  930. inherited buildderefimpl;
  931. if assigned(t1) then
  932. t1.buildderefimpl;
  933. if assigned(t2) then
  934. t2.buildderefimpl;
  935. end;
  936. procedure tloopnode.derefimpl;
  937. begin
  938. inherited derefimpl;
  939. if assigned(t1) then
  940. t1.derefimpl;
  941. if assigned(t2) then
  942. t2.derefimpl;
  943. end;
  944. function tloopnode.dogetcopy : tnode;
  945. var
  946. p : tloopnode;
  947. begin
  948. p:=tloopnode(inherited dogetcopy);
  949. if assigned(t1) then
  950. p.t1:=t1.dogetcopy
  951. else
  952. p.t1:=nil;
  953. if assigned(t2) then
  954. p.t2:=t2.dogetcopy
  955. else
  956. p.t2:=nil;
  957. p.loopflags:=loopflags;
  958. dogetcopy:=p;
  959. end;
  960. procedure tloopnode.insertintolist(l : tnodelist);
  961. begin
  962. end;
  963. procedure tloopnode.printnodetree(var t:text);
  964. begin
  965. write(t,printnodeindention,'(');
  966. printnodeindent;
  967. printnodeinfo(t);
  968. writeln(t);
  969. printnode(t,left);
  970. printnode(t,right);
  971. printnode(t,t1);
  972. printnode(t,t2);
  973. printnodeunindent;
  974. writeln(t,printnodeindention,')');
  975. end;
  976. {$ifdef DEBUG_NODE_XML}
  977. procedure TLoopNode.XMLPrintNodeInfo(var T: Text);
  978. var
  979. i: TLoopFlag;
  980. First: Boolean;
  981. begin
  982. inherited XMLPrintNodeInfo(T);
  983. First := True;
  984. for i := Low(TLoopFlag) to High(TLoopFlag) do
  985. if i in loopflags then
  986. begin
  987. if First then
  988. begin
  989. Write(T, ' loopflags="', i);
  990. First := False;
  991. end
  992. else
  993. Write(T, ',', i)
  994. end;
  995. if not First then
  996. Write(T, '"');
  997. end;
  998. procedure TLoopNode.XMLPrintNodeTree(var T: Text);
  999. begin
  1000. Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
  1001. XMLPrintNodeInfo(T);
  1002. WriteLn(T, '>');
  1003. PrintNodeIndent;
  1004. if Assigned(Left) then
  1005. begin
  1006. if nodetype = forn then
  1007. WriteLn(T, PrintNodeIndention, '<counter>')
  1008. else
  1009. WriteLn(T, PrintNodeIndention, '<condition>');
  1010. PrintNodeIndent;
  1011. XMLPrintNode(T, Left);
  1012. PrintNodeUnindent;
  1013. if nodetype = forn then
  1014. WriteLn(T, PrintNodeIndention, '</counter>')
  1015. else
  1016. WriteLn(T, PrintNodeIndention, '</condition>');
  1017. end;
  1018. if Assigned(Right) then
  1019. begin
  1020. case nodetype of
  1021. ifn:
  1022. WriteLn(T, PrintNodeIndention, '<then>');
  1023. forn:
  1024. WriteLn(T, PrintNodeIndention, '<first>');
  1025. else
  1026. WriteLn(T, PrintNodeIndention, '<right>');
  1027. end;
  1028. PrintNodeIndent;
  1029. XMLPrintNode(T, Right);
  1030. PrintNodeUnindent;
  1031. case nodetype of
  1032. ifn:
  1033. WriteLn(T, PrintNodeIndention, '</then>');
  1034. forn:
  1035. WriteLn(T, PrintNodeIndention, '</first>');
  1036. else
  1037. WriteLn(T, PrintNodeIndention, '</right>');
  1038. end;
  1039. end;
  1040. if Assigned(t1) then
  1041. begin
  1042. case nodetype of
  1043. ifn:
  1044. WriteLn(T, PrintNodeIndention, '<else>');
  1045. forn:
  1046. WriteLn(T, PrintNodeIndention, '<last>');
  1047. else
  1048. WriteLn(T, PrintNodeIndention, '<t1>');
  1049. end;
  1050. PrintNodeIndent;
  1051. XMLPrintNode(T, t1);
  1052. PrintNodeUnindent;
  1053. case nodetype of
  1054. ifn:
  1055. WriteLn(T, PrintNodeIndention, '</else>');
  1056. forn:
  1057. WriteLn(T, PrintNodeIndention, '</last>');
  1058. else
  1059. WriteLn(T, PrintNodeIndention, '</t1>');
  1060. end;
  1061. end;
  1062. if Assigned(t2) then
  1063. begin
  1064. if nodetype <> forn then
  1065. begin
  1066. WriteLn(T, PrintNodeIndention, '<loop>');
  1067. PrintNodeIndent;
  1068. end;
  1069. XMLPrintNode(T, t2);
  1070. if nodetype <> forn then
  1071. begin
  1072. PrintNodeUnindent;
  1073. WriteLn(T, PrintNodeIndention, '</loop>');
  1074. end;
  1075. end;
  1076. PrintNodeUnindent;
  1077. WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
  1078. end;
  1079. {$endif DEBUG_NODE_XML}
  1080. function tloopnode.docompare(p: tnode): boolean;
  1081. begin
  1082. docompare :=
  1083. inherited docompare(p) and
  1084. (loopflags*loopflagsequal=tloopnode(p).loopflags*loopflagsequal) and
  1085. t1.isequal(tloopnode(p).t1) and
  1086. t2.isequal(tloopnode(p).t2);
  1087. end;
  1088. {****************************************************************************
  1089. TWHILEREPEATNODE
  1090. *****************************************************************************}
  1091. constructor Twhilerepeatnode.create(l,r:Tnode;tab,cn:boolean);
  1092. begin
  1093. inherited create(whilerepeatn,l,r,nil,nil);
  1094. if tab then
  1095. include(loopflags, lnf_testatbegin);
  1096. if cn then
  1097. include(loopflags,lnf_checknegate);
  1098. end;
  1099. function twhilerepeatnode.pass_typecheck:tnode;
  1100. var
  1101. t:Tunarynode;
  1102. begin
  1103. result:=nil;
  1104. resultdef:=voidtype;
  1105. typecheckpass(left);
  1106. { tp procvar support }
  1107. maybe_call_procvar(left,true);
  1108. {A not node can be removed.}
  1109. if left.nodetype=notn then
  1110. begin
  1111. t:=Tunarynode(left);
  1112. left:=Tunarynode(left).left;
  1113. t.left:=nil;
  1114. t.destroy;
  1115. {Symdif operator, in case you are wondering:}
  1116. loopflags:=loopflags >< [lnf_checknegate];
  1117. end;
  1118. { loop instruction }
  1119. if assigned(right) then
  1120. typecheckpass(right);
  1121. set_varstate(left,vs_read,[vsf_must_be_valid]);
  1122. if codegenerror then
  1123. exit;
  1124. if not(is_boolean(left.resultdef)) and
  1125. not(is_typeparam(left.resultdef)) then
  1126. inserttypeconv(left,pasbool1type);
  1127. { Give warnings for code that will never be executed for
  1128. while false do }
  1129. if (lnf_testatbegin in loopflags) and
  1130. (left.nodetype=ordconstn) and
  1131. (tordconstnode(left).value.uvalue=0) and
  1132. assigned(right) then
  1133. CGMessagePos(right.fileinfo,cg_w_unreachable_code);
  1134. end;
  1135. {$ifdef prefetchnext}
  1136. type
  1137. passignmentquery = ^tassignmentquery;
  1138. tassignmentquery = record
  1139. towhat: tnode;
  1140. source: tassignmentnode;
  1141. statementcount: cardinal;
  1142. end;
  1143. function checkassignment(var n: tnode; arg: pointer): foreachnoderesult;
  1144. var
  1145. query: passignmentquery absolute arg;
  1146. temp, prederef: tnode;
  1147. begin
  1148. result := fen_norecurse_false;
  1149. if (n.nodetype in [assignn,inlinen,forn,calln,whilerepeatn,casen,ifn]) then
  1150. inc(query^.statementcount);
  1151. { make sure there's something else in the loop besides going to the }
  1152. { next item }
  1153. if (query^.statementcount > 1) and
  1154. (n.nodetype = assignn) then
  1155. begin
  1156. { skip type conversions of assignment target }
  1157. temp := tassignmentnode(n).left;
  1158. while (temp.nodetype = typeconvn) do
  1159. temp := ttypeconvnode(temp).left;
  1160. { assignment to x of the while assigned(x) check? }
  1161. if not(temp.isequal(query^.towhat)) then
  1162. exit;
  1163. { right hand side of assignment dereferenced field of }
  1164. { x? (no derefn in case of class) }
  1165. temp := tassignmentnode(n).right;
  1166. while (temp.nodetype = typeconvn) do
  1167. temp := ttypeconvnode(temp).left;
  1168. if (temp.nodetype <> subscriptn) then
  1169. exit;
  1170. prederef := tsubscriptnode(temp).left;
  1171. temp := prederef;
  1172. while (temp.nodetype = typeconvn) do
  1173. temp := ttypeconvnode(temp).left;
  1174. { see tests/test/prefetch1.pp }
  1175. if (temp.nodetype = derefn) then
  1176. temp := tderefnode(temp).left
  1177. else
  1178. temp := prederef;
  1179. if temp.isequal(query^.towhat) then
  1180. begin
  1181. query^.source := tassignmentnode(n);
  1182. result := fen_norecurse_true;
  1183. end
  1184. end
  1185. { don't check nodes which can't contain an assignment or whose }
  1186. { final assignment can vary a lot }
  1187. else if not(n.nodetype in [calln,inlinen,casen,whilerepeatn,forn]) then
  1188. result := fen_false;
  1189. end;
  1190. function findassignment(where: tnode; towhat: tnode): tassignmentnode;
  1191. var
  1192. query: tassignmentquery;
  1193. begin
  1194. query.towhat := towhat;
  1195. query.source := nil;
  1196. query.statementcount := 0;
  1197. if foreachnodestatic(where,@checkassignment,@query) then
  1198. result := query.source
  1199. else
  1200. result := nil;
  1201. end;
  1202. {$endif prefetchnext}
  1203. function twhilerepeatnode.pass_1 : tnode;
  1204. {$ifdef prefetchnext}
  1205. var
  1206. runnernode, prefetchcode: tnode;
  1207. assignmentnode: tassignmentnode;
  1208. prefetchstatements: tstatementnode;
  1209. {$endif prefetchnext}
  1210. begin
  1211. result:=nil;
  1212. expectloc:=LOC_VOID;
  1213. firstpass(left);
  1214. if codegenerror then
  1215. exit;
  1216. { loop instruction }
  1217. if assigned(right) then
  1218. begin
  1219. firstpass(right);
  1220. if codegenerror then
  1221. exit;
  1222. end;
  1223. {$ifdef prefetchnext}
  1224. { do at the end so all complex typeconversions are already }
  1225. { converted to calln's }
  1226. if (cs_opt_level1 in current_settings.optimizerswitches) and
  1227. (lnf_testatbegin in loopflags) then
  1228. begin
  1229. { get first component of the while check }
  1230. runnernode := left;
  1231. while (runnernode.nodetype in [andn,orn,notn,xorn,typeconvn]) do
  1232. runnernode := tunarynode(runnernode).left;
  1233. { is it an assigned(x) check? }
  1234. if ((runnernode.nodetype = inlinen) and
  1235. (tinlinenode(runnernode).inlinenumber = in_assigned_x)) or
  1236. ((runnernode.nodetype = unequaln) and
  1237. (taddnode(runnernode).right.nodetype = niln)) then
  1238. begin
  1239. runnernode := tunarynode(runnernode).left;
  1240. { in case of in_assigned_x, there's a callparan in between }
  1241. if (runnernode.nodetype = callparan) then
  1242. runnernode := tcallparanode(runnernode).left;
  1243. while (runnernode.nodetype = typeconvn) do
  1244. runnernode := ttypeconvnode(runnernode).left;
  1245. { is there an "x := x(^).somefield"? }
  1246. assignmentnode := findassignment(right,runnernode);
  1247. if assigned(assignmentnode) then
  1248. begin
  1249. prefetchcode := internalstatements(prefetchstatements);
  1250. addstatement(prefetchstatements,geninlinenode(in_prefetch_var,false,
  1251. cderefnode.create(ctypeconvnode.create(assignmentnode.right.getcopy,voidpointertype))));
  1252. addstatement(prefetchstatements,right);
  1253. right := prefetchcode;
  1254. typecheckpass(right);
  1255. end;
  1256. end;
  1257. end;
  1258. {$endif prefetchnext}
  1259. end;
  1260. {$ifdef state_tracking}
  1261. function Twhilerepeatnode.track_state_pass(exec_known:boolean):boolean;
  1262. var condition:Tnode;
  1263. code:Tnode;
  1264. done:boolean;
  1265. value:boolean;
  1266. change:boolean;
  1267. firsttest:boolean;
  1268. factval:Tnode;
  1269. begin
  1270. track_state_pass:=false;
  1271. done:=false;
  1272. firsttest:=true;
  1273. {For repeat until statements, first do a pass through the code.}
  1274. if not(lnf_testatbegin in flags) then
  1275. begin
  1276. code:=right.getcopy;
  1277. if code.track_state_pass(exec_known) then
  1278. track_state_pass:=true;
  1279. code.destroy;
  1280. end;
  1281. repeat
  1282. condition:=left.getcopy;
  1283. code:=right.getcopy;
  1284. change:=condition.track_state_pass(exec_known);
  1285. factval:=aktstate.find_fact(left);
  1286. if factval<>nil then
  1287. begin
  1288. condition.destroy;
  1289. condition:=factval.getcopy;
  1290. change:=true;
  1291. end;
  1292. if change then
  1293. begin
  1294. track_state_pass:=true;
  1295. {Force new resultdef pass.}
  1296. condition.resultdef:=nil;
  1297. do_typecheckpass(condition);
  1298. end;
  1299. if is_constboolnode(condition) then
  1300. begin
  1301. {Try to turn a while loop into a repeat loop.}
  1302. if firsttest then
  1303. exclude(flags,testatbegin);
  1304. value:=(Tordconstnode(condition).value<>0) xor checknegate;
  1305. if value then
  1306. begin
  1307. if code.track_state_pass(exec_known) then
  1308. track_state_pass:=true;
  1309. end
  1310. else
  1311. done:=true;
  1312. end
  1313. else
  1314. begin
  1315. {Remove any modified variables from the state.}
  1316. code.track_state_pass(false);
  1317. done:=true;
  1318. end;
  1319. code.destroy;
  1320. condition.destroy;
  1321. firsttest:=false;
  1322. until done;
  1323. {The loop condition is also known, for example:
  1324. while i<10 do
  1325. begin
  1326. ...
  1327. end;
  1328. When the loop is done, we do know that i<10 = false.
  1329. }
  1330. condition:=left.getcopy;
  1331. if condition.track_state_pass(exec_known) then
  1332. begin
  1333. track_state_pass:=true;
  1334. {Force new resultdef pass.}
  1335. condition.resultdef:=nil;
  1336. do_typecheckpass(condition);
  1337. end;
  1338. if not is_constboolnode(condition) then
  1339. aktstate.store_fact(condition,
  1340. cordconstnode.create(byte(checknegate),pasbool1type,true))
  1341. else
  1342. condition.destroy;
  1343. end;
  1344. {$endif}
  1345. {*****************************************************************************
  1346. TIFNODE
  1347. *****************************************************************************}
  1348. constructor tifnode.create(l,r,_t1 : tnode);
  1349. begin
  1350. inherited create(ifn,l,r,_t1,nil);
  1351. end;
  1352. constructor tifnode.create_internal(l,r,_t1 : tnode);
  1353. begin
  1354. create(l,r,_t1);
  1355. include(flags,nf_internal);
  1356. end;
  1357. function tifnode.internalsimplify(warn: boolean) : tnode;
  1358. begin
  1359. result:=nil;
  1360. { optimize constant expressions }
  1361. if (left.nodetype=ordconstn) then
  1362. begin
  1363. if tordconstnode(left).value.uvalue<>0 then
  1364. begin
  1365. if assigned(right) then
  1366. result:=right
  1367. else
  1368. result:=cnothingnode.create;
  1369. right:=nil;
  1370. if warn and assigned(t1) then
  1371. CGMessagePos(t1.fileinfo,cg_w_unreachable_code);
  1372. end
  1373. else
  1374. begin
  1375. if assigned(t1) then
  1376. result:=t1
  1377. else
  1378. result:=cnothingnode.create;
  1379. t1:=nil;
  1380. if warn and assigned(right) then
  1381. CGMessagePos(right.fileinfo,cg_w_unreachable_code);
  1382. end;
  1383. end;
  1384. end;
  1385. function tifnode.simplify(forinline : boolean) : tnode;
  1386. begin
  1387. result:=internalsimplify(false);
  1388. end;
  1389. function tifnode.pass_typecheck:tnode;
  1390. begin
  1391. result:=nil;
  1392. resultdef:=voidtype;
  1393. typecheckpass(left);
  1394. { tp procvar support }
  1395. maybe_call_procvar(left,true);
  1396. { if path }
  1397. if assigned(right) then
  1398. typecheckpass(right);
  1399. { else path }
  1400. if assigned(t1) then
  1401. typecheckpass(t1);
  1402. set_varstate(left,vs_read,[vsf_must_be_valid]);
  1403. if codegenerror then
  1404. exit;
  1405. if not(is_boolean(left.resultdef)) and
  1406. not(is_typeparam(left.resultdef)) then
  1407. inserttypeconv(left,pasbool1type);
  1408. result:=internalsimplify(not(nf_internal in flags));
  1409. end;
  1410. function tifnode.pass_1 : tnode;
  1411. begin
  1412. result:=nil;
  1413. expectloc:=LOC_VOID;
  1414. firstpass(left);
  1415. { if path }
  1416. if assigned(right) then
  1417. firstpass(right);
  1418. { else path }
  1419. if assigned(t1) then
  1420. firstpass(t1);
  1421. { leave if we've got an error in one of the paths }
  1422. if codegenerror then
  1423. exit;
  1424. end;
  1425. {*****************************************************************************
  1426. TFORNODE
  1427. *****************************************************************************}
  1428. constructor tfornode.create(l,r,_t1,_t2 : tnode;back : boolean);
  1429. begin
  1430. inherited create(forn,l,r,_t1,_t2);
  1431. if back then
  1432. include(loopflags,lnf_backward);
  1433. include(loopflags,lnf_testatbegin);
  1434. end;
  1435. function tfornode.simplify(forinline : boolean) : tnode;
  1436. begin
  1437. result:=nil;
  1438. { Can we spare the first comparision? }
  1439. if (t1.nodetype=ordconstn) and
  1440. (right.nodetype=ordconstn) and
  1441. (
  1442. (
  1443. (lnf_backward in loopflags) and
  1444. (Tordconstnode(right).value>=Tordconstnode(t1).value)
  1445. ) or
  1446. (
  1447. not(lnf_backward in loopflags) and
  1448. (Tordconstnode(right).value<=Tordconstnode(t1).value)
  1449. )
  1450. ) then
  1451. exclude(loopflags,lnf_testatbegin);
  1452. if (t1.nodetype=ordconstn) and
  1453. (right.nodetype=ordconstn) and
  1454. (
  1455. (
  1456. (lnf_backward in loopflags) and
  1457. (tordconstnode(right).value<tordconstnode(t1).value)
  1458. ) or
  1459. (
  1460. not(lnf_backward in loopflags) and
  1461. (tordconstnode(right).value>tordconstnode(t1).value)
  1462. )
  1463. ) then
  1464. result:=cnothingnode.create;
  1465. end;
  1466. function tfornode.pass_typecheck:tnode;
  1467. var
  1468. res : tnode;
  1469. rangedef: tdef;
  1470. begin
  1471. result:=nil;
  1472. resultdef:=voidtype;
  1473. { process the loopvar, from and to, varstates are already set }
  1474. typecheckpass(left);
  1475. typecheckpass(right);
  1476. typecheckpass(t1);
  1477. set_varstate(left,vs_written,[]);
  1478. { loop unrolling }
  1479. if (cs_opt_loopunroll in current_settings.optimizerswitches) and
  1480. assigned(t2) and
  1481. { statements must be error free }
  1482. not(nf_error in t2.flags) then
  1483. begin
  1484. typecheckpass(t2);
  1485. res:=t2.simplify(false);
  1486. if assigned(res) then
  1487. t2:=res;
  1488. res:=unroll_loop(self);
  1489. if assigned(res) then
  1490. begin
  1491. typecheckpass(res);
  1492. result:=res;
  1493. exit;
  1494. end;
  1495. end;
  1496. { Make sure that the loop var and the
  1497. from and to values are compatible types }
  1498. if not(m_iso in current_settings.modeswitches) then
  1499. rangedef:=left.resultdef
  1500. else
  1501. rangedef:=get_iso_range_type(left.resultdef);
  1502. check_ranges(right.fileinfo,right,rangedef);
  1503. inserttypeconv(right,rangedef);
  1504. check_ranges(t1.fileinfo,t1,rangedef);
  1505. inserttypeconv(t1,rangedef);
  1506. if assigned(t2) then
  1507. typecheckpass(t2);
  1508. result:=simplify(false);
  1509. end;
  1510. function tfornode.pass_1 : tnode;
  1511. var
  1512. ifblock,loopblock : tblocknode;
  1513. ifstatements,statements,loopstatements : tstatementnode;
  1514. fromtemp,totemp : ttempcreatenode;
  1515. do_loopvar_at_end : Boolean;
  1516. { if the lower and/or upper bound are variable, we need a surrounding if }
  1517. needsifblock : Boolean;
  1518. cond : tnodetype;
  1519. fromexpr : tnode;
  1520. toexpr : tnode;
  1521. { if the upper bound is not constant, it must be store in a temp initially }
  1522. usetotemp : boolean;
  1523. { if the lower bound is not constant, it must be store in a temp before calculating the upper bound }
  1524. usefromtemp : boolean;
  1525. procedure iterate_counter(var s : tstatementnode;fw : boolean);
  1526. begin
  1527. if fw then
  1528. addstatement(s,
  1529. cassignmentnode.create_internal(left.getcopy,cinlinenode.createintern(in_succ_x,false,left.getcopy)))
  1530. else
  1531. addstatement(s,
  1532. cassignmentnode.create_internal(left.getcopy,cinlinenode.createintern(in_pred_x,false,left.getcopy)));
  1533. end;
  1534. function iterate_counter_func(arg : tnode;fw : boolean) : tnode;
  1535. begin
  1536. if fw then
  1537. result:=cinlinenode.createintern(in_succ_x,false,arg)
  1538. else
  1539. result:=cinlinenode.createintern(in_pred_x,false,arg);
  1540. end;
  1541. begin
  1542. result:=nil;
  1543. expectloc:=LOC_VOID;
  1544. fromtemp:=nil;
  1545. totemp:=nil;
  1546. firstpass(left);
  1547. firstpass(right);
  1548. firstpass(t1);
  1549. if assigned(t2) then
  1550. begin
  1551. firstpass(t2);
  1552. if codegenerror then
  1553. exit;
  1554. end;
  1555. { first set the to value
  1556. because the count var can be in the expression ! }
  1557. do_loopvar_at_end:=(lnf_dont_mind_loopvar_on_exit in loopflags)
  1558. { if the loop is unrolled and there is a jump into the loop,
  1559. then we can't do the trick with incrementing the loop var only at the
  1560. end
  1561. }
  1562. and not(assigned(entrylabel));
  1563. { calculate pointer value and check if changeable and if so
  1564. load into temporary variable }
  1565. if (right.nodetype<>ordconstn) or (t1.nodetype<>ordconstn) then
  1566. begin
  1567. do_loopvar_at_end:=false;
  1568. needsifblock:=true;
  1569. end
  1570. else
  1571. needsifblock:=false;
  1572. { convert the for loop into a while loop }
  1573. result:=internalstatements(statements);
  1574. ifblock:=internalstatements(ifstatements);
  1575. loopblock:=internalstatements(loopstatements);
  1576. usefromtemp:=(might_have_sideeffects(t1) and not(is_const(right))) or (node_complexity(right)>1);
  1577. usetotemp:=not(is_const(t1));
  1578. if needsifblock then
  1579. begin
  1580. { do not generate a temp. for the from node, if it is a const, it can be copied directly since
  1581. no side effect might change it }
  1582. if usefromtemp then
  1583. begin
  1584. fromtemp:=ctempcreatenode.create(right.resultdef,right.resultdef.size,tt_persistent,true);
  1585. { the if block might be optimized out, so we put the deletetempnode after the if-block, however,
  1586. this causes a long life time of the fromtemp. If the final regsync is left away, the reg. allocator
  1587. figures out the needed life time. As their are no loops involved between the uses of the fromtemp,
  1588. this does no hurt }
  1589. fromtemp.includetempflag(ti_no_final_regsync);
  1590. addstatement(statements,fromtemp);
  1591. { while it would be beneficial to fold the initial reverse succ/pred into this assignment, this is
  1592. not possible because it might wrap around and the if check later on goes wrong }
  1593. addstatement(statements,cassignmentnode.create_internal(ctemprefnode.create(fromtemp),right.getcopy));
  1594. end;
  1595. if usetotemp then
  1596. begin
  1597. totemp:=ctempcreatenode.create(t1.resultdef,t1.resultdef.size,tt_persistent,true);
  1598. addstatement(statements,totemp);
  1599. addstatement(statements,cassignmentnode.create_internal(ctemprefnode.create(totemp),t1.getcopy));
  1600. end;
  1601. if usefromtemp then
  1602. begin
  1603. addstatement(ifstatements,cassignmentnode.create_internal(left.getcopy,ctemprefnode.create(fromtemp)));
  1604. if not(do_loopvar_at_end) then
  1605. iterate_counter(ifstatements,lnf_backward in loopflags);
  1606. end
  1607. else
  1608. begin
  1609. if not(do_loopvar_at_end) then
  1610. addstatement(ifstatements,cassignmentnode.create_internal(left.getcopy,
  1611. iterate_counter_func(right.getcopy,lnf_backward in loopflags)))
  1612. else
  1613. addstatement(ifstatements,cassignmentnode.create_internal(left.getcopy,right.getcopy));
  1614. end;
  1615. end
  1616. else
  1617. begin
  1618. if not(do_loopvar_at_end) then
  1619. addstatement(ifstatements,cassignmentnode.create_internal(left.getcopy,
  1620. iterate_counter_func(right.getcopy,lnf_backward in loopflags)))
  1621. else
  1622. addstatement(ifstatements,cassignmentnode.create_internal(left.getcopy,right.getcopy));
  1623. end;
  1624. if assigned(entrylabel) then
  1625. addstatement(ifstatements,cgotonode.create(tlabelnode(entrylabel).labsym));
  1626. if not(do_loopvar_at_end) then
  1627. iterate_counter(loopstatements,not(lnf_backward in loopflags));
  1628. { avoid copying t2, it is used only once and it might be big }
  1629. addstatement(loopstatements,t2);
  1630. t2:=nil;
  1631. if do_loopvar_at_end then
  1632. iterate_counter(loopstatements,not(lnf_backward in loopflags));
  1633. if do_loopvar_at_end then
  1634. begin
  1635. if lnf_backward in loopflags then
  1636. cond:=ltn
  1637. else
  1638. cond:=gtn;
  1639. end
  1640. else
  1641. begin
  1642. if lnf_backward in loopflags then
  1643. cond:=lten
  1644. else
  1645. cond:=gten;
  1646. end;
  1647. if needsifblock then
  1648. begin
  1649. if usetotemp then
  1650. toexpr:=ctemprefnode.create(totemp)
  1651. else
  1652. toexpr:=t1.getcopy;
  1653. addstatement(ifstatements,cwhilerepeatnode.create(caddnode.create_internal(cond,left.getcopy,toexpr),loopblock,false,true));
  1654. if usefromtemp then
  1655. fromexpr:=ctemprefnode.create(fromtemp)
  1656. else
  1657. fromexpr:=right.getcopy;
  1658. if usetotemp then
  1659. toexpr:=ctemprefnode.create(totemp)
  1660. else
  1661. toexpr:=t1.getcopy;
  1662. if lnf_backward in loopflags then
  1663. addstatement(statements,cifnode.create(caddnode.create_internal(gten,
  1664. fromexpr,toexpr),ifblock,nil))
  1665. else
  1666. addstatement(statements,cifnode.create(caddnode.create_internal(lten,
  1667. fromexpr,toexpr),ifblock,nil));
  1668. if usetotemp then
  1669. addstatement(statements,ctempdeletenode.create(totemp));
  1670. if usefromtemp then
  1671. addstatement(statements,ctempdeletenode.create(fromtemp));
  1672. end
  1673. else
  1674. begin
  1675. addstatement(ifstatements,cwhilerepeatnode.create(caddnode.create_internal(cond,left.getcopy,t1.getcopy),loopblock,false,true));
  1676. addstatement(statements,ifblock);
  1677. end;
  1678. end;
  1679. {*****************************************************************************
  1680. TEXITNODE
  1681. *****************************************************************************}
  1682. constructor texitnode.create(l:tnode);
  1683. begin
  1684. inherited create(exitn,l);
  1685. if assigned(left) then
  1686. begin
  1687. { add assignment to funcretsym }
  1688. left:=ctypeconvnode.create(left,current_procinfo.procdef.returndef);
  1689. left:=cassignmentnode.create(
  1690. cloadnode.create(current_procinfo.procdef.funcretsym,current_procinfo.procdef.funcretsym.owner),
  1691. left);
  1692. end;
  1693. end;
  1694. constructor texitnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  1695. begin
  1696. inherited ppuload(t,ppufile);
  1697. end;
  1698. procedure texitnode.ppuwrite(ppufile:tcompilerppufile);
  1699. begin
  1700. inherited ppuwrite(ppufile);
  1701. end;
  1702. function texitnode.pass_typecheck:tnode;
  1703. var
  1704. newstatement : tstatementnode;
  1705. ressym: tsym;
  1706. resdef: tdef;
  1707. begin
  1708. result:=nil;
  1709. newstatement:=nil;
  1710. if assigned(left) then
  1711. begin
  1712. result:=internalstatements(newstatement);
  1713. addstatement(newstatement,left);
  1714. left:=nil;
  1715. end;
  1716. { if the function result has been migrated to the parentfpstruct,
  1717. we have to load it back to the original location (from which the
  1718. code generator will load it into the function result location),
  1719. because the code to this that we add in tnodeutils.wrap_proc_body()
  1720. gets inserted before the exit label to which this node will jump }
  1721. if (target_info.system in systems_fpnestedstruct) and
  1722. not(nf_internal in flags) and
  1723. current_procinfo.procdef.get_funcretsym_info(ressym,resdef) and
  1724. (tabstractnormalvarsym(ressym).inparentfpstruct) then
  1725. begin
  1726. if not assigned(result) then
  1727. result:=internalstatements(newstatement);
  1728. cnodeutils.load_parentfpstruct_nested_funcret(ressym,newstatement);
  1729. end;
  1730. if assigned(result) then
  1731. begin
  1732. addstatement(newstatement,self.getcopy);
  1733. { ensure we don't insert the function result loading code again for
  1734. this node }
  1735. include(newstatement.left.flags,nf_internal);
  1736. end;
  1737. resultdef:=voidtype;
  1738. end;
  1739. function texitnode.pass_1 : tnode;
  1740. begin
  1741. result:=nil;
  1742. expectloc:=LOC_VOID;
  1743. if assigned(left) then
  1744. internalerror(2011052801);
  1745. end;
  1746. {*****************************************************************************
  1747. TBREAKNODE
  1748. *****************************************************************************}
  1749. constructor tbreaknode.create;
  1750. begin
  1751. inherited create(breakn);
  1752. end;
  1753. function tbreaknode.pass_typecheck:tnode;
  1754. begin
  1755. result:=nil;
  1756. resultdef:=voidtype;
  1757. end;
  1758. function tbreaknode.pass_1 : tnode;
  1759. begin
  1760. result:=nil;
  1761. expectloc:=LOC_VOID;
  1762. end;
  1763. {*****************************************************************************
  1764. TCONTINUENODE
  1765. *****************************************************************************}
  1766. constructor tcontinuenode.create;
  1767. begin
  1768. inherited create(continuen);
  1769. end;
  1770. function tcontinuenode.pass_typecheck:tnode;
  1771. begin
  1772. result:=nil;
  1773. resultdef:=voidtype;
  1774. end;
  1775. function tcontinuenode.pass_1 : tnode;
  1776. begin
  1777. result:=nil;
  1778. expectloc:=LOC_VOID;
  1779. end;
  1780. {*****************************************************************************
  1781. TGOTONODE
  1782. *****************************************************************************}
  1783. constructor tgotonode.create(p : tlabelsym);
  1784. begin
  1785. inherited create(goton);
  1786. exceptionblock:=current_exceptblock;
  1787. labelnode:=nil;
  1788. labelsym:=p;
  1789. end;
  1790. constructor tgotonode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  1791. begin
  1792. inherited ppuload(t,ppufile);
  1793. labelnodeidx:=ppufile.getlongint;
  1794. exceptionblock:=ppufile.getbyte;
  1795. end;
  1796. procedure tgotonode.ppuwrite(ppufile:tcompilerppufile);
  1797. begin
  1798. inherited ppuwrite(ppufile);
  1799. labelnodeidx:=labelnode.ppuidx;
  1800. ppufile.putlongint(labelnodeidx);
  1801. ppufile.putbyte(exceptionblock);
  1802. end;
  1803. procedure tgotonode.buildderefimpl;
  1804. begin
  1805. inherited buildderefimpl;
  1806. end;
  1807. procedure tgotonode.derefimpl;
  1808. begin
  1809. inherited derefimpl;
  1810. end;
  1811. procedure tgotonode.resolveppuidx;
  1812. begin
  1813. labelnode:=tlabelnode(nodeppuidxget(labelnodeidx));
  1814. if labelnode.nodetype<>labeln then
  1815. internalerror(200809021);
  1816. end;
  1817. function tgotonode.pass_typecheck:tnode;
  1818. begin
  1819. result:=nil;
  1820. resultdef:=voidtype;
  1821. end;
  1822. function tgotonode.pass_1 : tnode;
  1823. var
  1824. p2 : tprocinfo;
  1825. begin
  1826. result:=nil;
  1827. expectloc:=LOC_VOID;
  1828. { The labelnode can already be set when
  1829. this node was copied }
  1830. if not(assigned(labelnode)) then
  1831. begin
  1832. { inner procedure goto? }
  1833. if assigned(labelsym.code) and
  1834. ((assigned(labelsym.owner) and (current_procinfo.procdef.parast.symtablelevel=labelsym.owner.symtablelevel)) or
  1835. { generated by the optimizer? }
  1836. not(assigned(labelsym.owner))) then
  1837. labelnode:=tlabelnode(labelsym.code)
  1838. else if ((m_non_local_goto in current_settings.modeswitches) and
  1839. assigned(labelsym.owner)) or
  1840. { nested exits don't need the non local goto switch }
  1841. (labelsym.realname='$nestedexit') then
  1842. begin
  1843. if current_procinfo.procdef.parast.symtablelevel>labelsym.owner.symtablelevel then
  1844. begin
  1845. { don't mess with the exception blocks, global gotos in/out side exception blocks are not allowed }
  1846. if exceptionblock>0 then
  1847. CGMessage(cg_e_goto_inout_of_exception_block);
  1848. { goto across procedures using exception?
  1849. this is not allowed because we cannot
  1850. easily unwind the exception frame
  1851. stack
  1852. }
  1853. p2:=current_procinfo;
  1854. while true do
  1855. begin
  1856. if (p2.flags*[pi_needs_implicit_finally,pi_uses_exceptions,pi_has_implicit_finally])<>[] then
  1857. Message(cg_e_goto_across_procedures_with_exceptions_not_allowed);
  1858. if labelsym.owner=p2.procdef.localst then
  1859. break;
  1860. p2:=p2.parent
  1861. end;
  1862. if assigned(labelsym.jumpbuf) then
  1863. begin
  1864. labelsym.nonlocal:=true;
  1865. result:=ccallnode.createintern('fpc_longjmp',
  1866. ccallparanode.create(cordconstnode.create(1,sinttype,true),
  1867. ccallparanode.create(cloadnode.create(labelsym.jumpbuf,labelsym.jumpbuf.owner),
  1868. nil)));
  1869. end
  1870. else
  1871. CGMessage1(cg_e_goto_label_not_found,labelsym.realname);
  1872. end
  1873. else
  1874. CGMessage(cg_e_interprocedural_goto_only_to_outer_scope_allowed);
  1875. end
  1876. else
  1877. CGMessage1(cg_e_goto_label_not_found,labelsym.realname);
  1878. end;
  1879. { check if we don't mess with exception blocks }
  1880. if assigned(labelnode) and
  1881. (exceptionblock<>labelnode.exceptionblock) then
  1882. CGMessage(cg_e_goto_inout_of_exception_block);
  1883. end;
  1884. function tgotonode.dogetcopy : tnode;
  1885. var
  1886. p : tgotonode;
  1887. begin
  1888. p:=tgotonode(inherited dogetcopy);
  1889. p.exceptionblock:=exceptionblock;
  1890. { generate labelnode if not done yet }
  1891. if not(assigned(labelnode)) then
  1892. begin
  1893. if assigned(labelsym) and assigned(labelsym.code) then
  1894. labelnode:=tlabelnode(labelsym.code)
  1895. end;
  1896. p.labelsym:=labelsym;
  1897. if assigned(labelnode) then
  1898. p.labelnode:=tlabelnode(labelnode.dogetcopy)
  1899. else
  1900. begin
  1901. { don't trigger IE when there was already an error, i.e. the
  1902. label is not defined. See tw11763 (PFV) }
  1903. if (errorcount=0) and
  1904. { don't trigger IE if it's a global goto }
  1905. ((assigned(labelsym.owner) and (current_procinfo.procdef.parast.symtablelevel=labelsym.owner.symtablelevel)) or
  1906. not(assigned(labelsym.owner))) then
  1907. internalerror(200610291);
  1908. end;
  1909. result:=p;
  1910. end;
  1911. function tgotonode.docompare(p: tnode): boolean;
  1912. begin
  1913. docompare := false;
  1914. end;
  1915. {*****************************************************************************
  1916. TLABELNODE
  1917. *****************************************************************************}
  1918. constructor tlabelnode.create(l:tnode;alabsym:tlabelsym);
  1919. begin
  1920. inherited create(labeln,l);
  1921. exceptionblock:=current_exceptblock;
  1922. labsym:=alabsym;
  1923. { Register labelnode in labelsym }
  1924. labsym.code:=self;
  1925. end;
  1926. constructor tlabelnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  1927. begin
  1928. inherited ppuload(t,ppufile);
  1929. exceptionblock:=ppufile.getbyte;
  1930. end;
  1931. destructor tlabelnode.destroy;
  1932. begin
  1933. if assigned(labsym) then
  1934. begin
  1935. if not assigned(labsym.Owner) then
  1936. labsym.Free // Free labelsym if it has no owner
  1937. else
  1938. if labsym.code=pointer(self) then
  1939. begin
  1940. { Remove reference in labelsym, this is to prevent
  1941. goto's to this label }
  1942. labsym.code:=nil;
  1943. end;
  1944. end;
  1945. inherited destroy;
  1946. end;
  1947. procedure tlabelnode.ppuwrite(ppufile:tcompilerppufile);
  1948. begin
  1949. inherited ppuwrite(ppufile);
  1950. ppufile.putbyte(exceptionblock);
  1951. end;
  1952. procedure tlabelnode.buildderefimpl;
  1953. begin
  1954. inherited buildderefimpl;
  1955. end;
  1956. procedure tlabelnode.derefimpl;
  1957. begin
  1958. inherited derefimpl;
  1959. end;
  1960. function tlabelnode.pass_typecheck:tnode;
  1961. begin
  1962. result:=nil;
  1963. { left could still be unassigned }
  1964. if assigned(left) then
  1965. typecheckpass(left);
  1966. resultdef:=voidtype;
  1967. end;
  1968. function tlabelnode.pass_1 : tnode;
  1969. begin
  1970. result:=nil;
  1971. expectloc:=LOC_VOID;
  1972. include(current_procinfo.flags,pi_has_label);
  1973. if assigned(left) then
  1974. firstpass(left);
  1975. if (m_non_local_goto in current_settings.modeswitches) and
  1976. { the owner can be Nil for internal labels }
  1977. assigned(labsym.owner) and
  1978. (current_procinfo.procdef.parast.symtablelevel<>labsym.owner.symtablelevel) then
  1979. CGMessage(cg_e_labels_cannot_defined_outside_declaration_scope)
  1980. end;
  1981. function tlabelnode.dogetcopy : tnode;
  1982. begin
  1983. if not(assigned(copiedto)) then
  1984. copiedto:=tlabelnode(inherited dogetcopy);
  1985. copiedto.exceptionblock:=exceptionblock;
  1986. result:=copiedto;
  1987. end;
  1988. function tlabelnode.docompare(p: tnode): boolean;
  1989. begin
  1990. docompare := false;
  1991. end;
  1992. {*****************************************************************************
  1993. TRAISENODE
  1994. *****************************************************************************}
  1995. constructor traisenode.create(l,taddr,tframe:tnode);
  1996. begin
  1997. inherited create(raisen,l,taddr,tframe);
  1998. end;
  1999. function traisenode.pass_typecheck:tnode;
  2000. begin
  2001. result:=nil;
  2002. resultdef:=voidtype;
  2003. if assigned(left) then
  2004. begin
  2005. { first para must be a _class_ }
  2006. typecheckpass(left);
  2007. set_varstate(left,vs_read,[vsf_must_be_valid]);
  2008. if codegenerror then
  2009. exit;
  2010. if not is_class(left.resultdef) and
  2011. not is_javaclass(left.resultdef) then
  2012. CGMessage1(type_e_class_type_expected,left.resultdef.typename);
  2013. { insert needed typeconvs for addr,frame }
  2014. if assigned(right) then
  2015. begin
  2016. { addr }
  2017. typecheckpass(right);
  2018. set_varstate(right,vs_read,[vsf_must_be_valid]);
  2019. inserttypeconv(right,voidcodepointertype);
  2020. { frame }
  2021. if assigned(third) then
  2022. begin
  2023. typecheckpass(third);
  2024. set_varstate(third,vs_read,[vsf_must_be_valid]);
  2025. inserttypeconv(third,voidpointertype);
  2026. end;
  2027. end;
  2028. end;
  2029. end;
  2030. function traisenode.pass_1 : tnode;
  2031. var
  2032. statements : tstatementnode;
  2033. current_addr : tlabelnode;
  2034. raisenode : tcallnode;
  2035. begin
  2036. result:=internalstatements(statements);
  2037. if assigned(left) then
  2038. begin
  2039. { first para must be a class }
  2040. firstpass(left);
  2041. { insert needed typeconvs for addr,frame }
  2042. if assigned(right) then
  2043. begin
  2044. { addr }
  2045. firstpass(right);
  2046. { frame }
  2047. if assigned(third) then
  2048. firstpass(third)
  2049. else
  2050. third:=cpointerconstnode.Create(0,voidpointertype);
  2051. end
  2052. else
  2053. begin
  2054. third:=cinlinenode.create(in_get_frame,false,nil);
  2055. current_addr:=clabelnode.create(cnothingnode.create,clabelsym.create('$raiseaddr'));
  2056. addstatement(statements,current_addr);
  2057. right:=caddrnode.create(cloadnode.create(current_addr.labsym,current_addr.labsym.owner));
  2058. { raise address off by one so we are for sure inside the action area for the raise }
  2059. if tf_use_psabieh in target_info.flags then
  2060. right:=caddnode.create_internal(addn,right,cordconstnode.create(1,sizesinttype,false));
  2061. end;
  2062. raisenode:=ccallnode.createintern('fpc_raiseexception',
  2063. ccallparanode.create(third,
  2064. ccallparanode.create(right,
  2065. ccallparanode.create(left,nil)))
  2066. );
  2067. include(raisenode.callnodeflags,cnf_call_never_returns);
  2068. addstatement(statements,raisenode);
  2069. end
  2070. else
  2071. begin
  2072. addstatement(statements,ccallnode.createintern('fpc_popaddrstack',nil));
  2073. raisenode:=ccallnode.createintern('fpc_reraise',nil);
  2074. include(raisenode.callnodeflags,cnf_call_never_returns);
  2075. addstatement(statements,raisenode);
  2076. end;
  2077. left:=nil;
  2078. right:=nil;
  2079. third:=nil;
  2080. end;
  2081. {*****************************************************************************
  2082. TTRYEXCEPTNODE
  2083. *****************************************************************************}
  2084. constructor ttryexceptnode.create(l,r,_t1 : tnode);
  2085. begin
  2086. inherited create(tryexceptn,l,r,_t1,nil);
  2087. end;
  2088. function ttryexceptnode.pass_typecheck:tnode;
  2089. begin
  2090. result:=nil;
  2091. typecheckpass(left);
  2092. { on statements }
  2093. if assigned(right) then
  2094. typecheckpass(right);
  2095. { else block }
  2096. if assigned(t1) then
  2097. typecheckpass(t1);
  2098. resultdef:=voidtype;
  2099. end;
  2100. function ttryexceptnode.pass_1 : tnode;
  2101. begin
  2102. result:=nil;
  2103. expectloc:=LOC_VOID;
  2104. firstpass(left);
  2105. { on statements }
  2106. if assigned(right) then
  2107. firstpass(right);
  2108. { else block }
  2109. if assigned(t1) then
  2110. firstpass(t1);
  2111. include(current_procinfo.flags,pi_do_call);
  2112. include(current_procinfo.flags,pi_uses_exceptions);
  2113. adjust_estimated_stack_size;
  2114. end;
  2115. function ttryexceptnode.simplify(forinline: boolean): tnode;
  2116. begin
  2117. result:=nil;
  2118. { empty try -> can never raise exception -> do nothing }
  2119. if has_no_code(left) then
  2120. result:=cnothingnode.create;
  2121. end;
  2122. procedure ttryexceptnode.adjust_estimated_stack_size;
  2123. begin
  2124. inc(current_procinfo.estimatedtempsize,rec_jmp_buf.size*2);
  2125. end;
  2126. {*****************************************************************************
  2127. TTRYFINALLYNODE
  2128. *****************************************************************************}
  2129. constructor ttryfinallynode.create(l,r:tnode);
  2130. begin
  2131. inherited create(tryfinallyn,l,r,nil);
  2132. third:=nil;
  2133. implicitframe:=false;
  2134. end;
  2135. constructor ttryfinallynode.create_implicit(l,r:tnode);
  2136. begin
  2137. inherited create(tryfinallyn,l,r,nil);
  2138. third:=nil;
  2139. implicitframe:=true;
  2140. end;
  2141. function ttryfinallynode.pass_typecheck:tnode;
  2142. begin
  2143. result:=nil;
  2144. resultdef:=voidtype;
  2145. typecheckpass(left);
  2146. // "try block" is "used"? (JM)
  2147. set_varstate(left,vs_readwritten,[vsf_must_be_valid]);
  2148. typecheckpass(right);
  2149. // "except block" is "used"? (JM)
  2150. set_varstate(right,vs_readwritten,[vsf_must_be_valid]);
  2151. if assigned(third) then
  2152. begin
  2153. typecheckpass(third);
  2154. set_varstate(third,vs_readwritten,[vsf_must_be_valid]);
  2155. end;
  2156. end;
  2157. function ttryfinallynode.pass_1 : tnode;
  2158. begin
  2159. result:=nil;
  2160. expectloc:=LOC_VOID;
  2161. firstpass(left);
  2162. firstpass(right);
  2163. if assigned(third) then
  2164. firstpass(third);
  2165. include(current_procinfo.flags,pi_do_call);
  2166. { pi_uses_exceptions is an information for the optimizer and it
  2167. is only interested in exceptions if they appear inside the body,
  2168. so ignore implicit frames when setting the flag }
  2169. if not(implicitframe) then
  2170. include(current_procinfo.flags,pi_uses_exceptions);
  2171. adjust_estimated_stack_size;
  2172. end;
  2173. function ttryfinallynode.simplify(forinline : boolean): tnode;
  2174. begin
  2175. result:=nil;
  2176. { if the try contains no code, we can kill
  2177. the try and except and return only the
  2178. finally part }
  2179. if has_no_code(left) then
  2180. begin
  2181. result:=right;
  2182. right:=nil;
  2183. end;
  2184. end;
  2185. procedure ttryfinallynode.adjust_estimated_stack_size;
  2186. begin
  2187. inc(current_procinfo.estimatedtempsize,rec_jmp_buf.size);
  2188. end;
  2189. {*****************************************************************************
  2190. TONNODE
  2191. *****************************************************************************}
  2192. constructor tonnode.create(l,r:tnode);
  2193. begin
  2194. inherited create(onn,l,r);
  2195. excepTSymtable:=nil;
  2196. excepttype:=nil;
  2197. end;
  2198. destructor tonnode.destroy;
  2199. begin
  2200. { copied nodes don't need to release the symtable }
  2201. if assigned(excepTSymtable) then
  2202. excepTSymtable.free;
  2203. inherited destroy;
  2204. end;
  2205. constructor tonnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  2206. begin
  2207. inherited ppuload(t,ppufile);
  2208. excepTSymtable:=nil;
  2209. excepttype:=nil;
  2210. end;
  2211. function tonnode.dogetcopy : tnode;
  2212. var
  2213. n : tonnode;
  2214. begin
  2215. n:=tonnode(inherited dogetcopy);
  2216. if assigned(exceptsymtable) then
  2217. n.exceptsymtable:=exceptsymtable.getcopy
  2218. else
  2219. n.exceptsymtable:=nil;
  2220. n.excepttype:=excepttype;
  2221. result:=n;
  2222. end;
  2223. function tonnode.pass_typecheck:tnode;
  2224. begin
  2225. result:=nil;
  2226. resultdef:=voidtype;
  2227. if not is_class(excepttype) and
  2228. not is_javaclass(excepttype) then
  2229. CGMessage1(type_e_class_type_expected,excepttype.typename);
  2230. if assigned(left) then
  2231. typecheckpass(left);
  2232. if assigned(right) then
  2233. typecheckpass(right);
  2234. end;
  2235. function tonnode.pass_1 : tnode;
  2236. begin
  2237. result:=nil;
  2238. include(current_procinfo.flags,pi_do_call);
  2239. expectloc:=LOC_VOID;
  2240. if assigned(left) then
  2241. firstpass(left);
  2242. if assigned(right) then
  2243. firstpass(right);
  2244. end;
  2245. function tonnode.docompare(p: tnode): boolean;
  2246. begin
  2247. docompare := false;
  2248. end;
  2249. end.