nflw.pas 86 KB

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