2
0

nflw.pas 88 KB

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