nflw.pas 102 KB

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