nflw.pas 102 KB

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