nflw.pas 101 KB

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