nflw.pas 106 KB

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