nflw.pas 105 KB

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