nflw.pas 95 KB

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