nflw.pas 86 KB

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