nflw.pas 95 KB

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