nflw.pas 108 KB

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