nflw.pas 94 KB

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