nflw.pas 71 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113
  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. symnot,
  25. symtype,symbase,symdef,symsym,
  26. optloop;
  27. type
  28. { flags used by loop nodes }
  29. tloopflag = (
  30. { set if it is a for ... downto ... do loop }
  31. lnf_backward,
  32. { Do we need to parse childs to set var state? }
  33. lnf_varstate,
  34. { Do a test at the begin of the loop?}
  35. lnf_testatbegin,
  36. { Negate the loop test? }
  37. lnf_checknegate,
  38. { Should the value of the loop variable on exit be correct. }
  39. lnf_dont_mind_loopvar_on_exit);
  40. tloopflags = set of tloopflag;
  41. const
  42. { loop flags which must match to consider loop nodes equal regarding the flags }
  43. loopflagsequal = [lnf_backward];
  44. type
  45. tlabelnode = class;
  46. tloopnode = class(tbinarynode)
  47. t1,t2 : tnode;
  48. loopflags : tloopflags;
  49. constructor create(tt : tnodetype;l,r,_t1,_t2 : tnode);virtual;
  50. destructor destroy;override;
  51. function dogetcopy : tnode;override;
  52. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  53. procedure ppuwrite(ppufile:tcompilerppufile);override;
  54. procedure buildderefimpl;override;
  55. procedure derefimpl;override;
  56. procedure insertintolist(l : tnodelist);override;
  57. procedure printnodetree(var t:text);override;
  58. function docompare(p: tnode): boolean; override;
  59. end;
  60. twhilerepeatnode = class(tloopnode)
  61. constructor create(l,r:Tnode;tab,cn:boolean);virtual;reintroduce;
  62. function pass_typecheck:tnode;override;
  63. function pass_1 : tnode;override;
  64. {$ifdef state_tracking}
  65. function track_state_pass(exec_known:boolean):boolean;override;
  66. {$endif}
  67. end;
  68. twhilerepeatnodeclass = class of twhilerepeatnode;
  69. tifnode = class(tloopnode)
  70. constructor create(l,r,_t1 : tnode);virtual;reintroduce;
  71. function pass_typecheck:tnode;override;
  72. function pass_1 : tnode;override;
  73. function simplify : tnode;override;
  74. private
  75. function internalsimplify(warn: boolean) : tnode;
  76. end;
  77. tifnodeclass = class of tifnode;
  78. tfornode = class(tloopnode)
  79. { if count isn divisable by unrolls then
  80. the for loop must jump to this label to get the correct
  81. number of executions }
  82. entrylabel : tnode;
  83. loopvar_notid:cardinal;
  84. constructor create(l,r,_t1,_t2 : tnode;back : boolean);virtual;reintroduce;
  85. procedure loop_var_access(not_type:Tnotification_flag;symbol:Tsym);
  86. function pass_typecheck:tnode;override;
  87. function pass_1 : tnode;override;
  88. function simplify : tnode;override;
  89. end;
  90. tfornodeclass = class of tfornode;
  91. texitnode = class(tunarynode)
  92. constructor create(l:tnode);virtual;
  93. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  94. procedure ppuwrite(ppufile:tcompilerppufile);override;
  95. function pass_typecheck:tnode;override;
  96. function pass_1 : tnode;override;
  97. end;
  98. texitnodeclass = class of texitnode;
  99. tbreaknode = class(tnode)
  100. constructor create;virtual;
  101. function pass_typecheck:tnode;override;
  102. function pass_1 : tnode;override;
  103. end;
  104. tbreaknodeclass = class of tbreaknode;
  105. tcontinuenode = class(tnode)
  106. constructor create;virtual;
  107. function pass_typecheck:tnode;override;
  108. function pass_1 : tnode;override;
  109. end;
  110. tcontinuenodeclass = class of tcontinuenode;
  111. tgotonode = class(tnode)
  112. private
  113. labelnodeidx : longint;
  114. public
  115. labelsym : tlabelsym;
  116. labelnode : tlabelnode;
  117. exceptionblock : integer;
  118. constructor create(p : tlabelsym);virtual;
  119. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  120. procedure ppuwrite(ppufile:tcompilerppufile);override;
  121. procedure buildderefimpl;override;
  122. procedure derefimpl;override;
  123. procedure resolveppuidx;override;
  124. function dogetcopy : tnode;override;
  125. function pass_typecheck:tnode;override;
  126. function pass_1 : tnode;override;
  127. function docompare(p: tnode): boolean; override;
  128. end;
  129. tgotonodeclass = class of tgotonode;
  130. tlabelnode = class(tunarynode)
  131. exceptionblock : integer;
  132. { when copying trees, this points to the newly created copy of a label }
  133. copiedto : tlabelnode;
  134. labsym : tlabelsym;
  135. constructor create(l:tnode;alabsym:tlabelsym);virtual;
  136. destructor destroy;override;
  137. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  138. procedure ppuwrite(ppufile:tcompilerppufile);override;
  139. procedure buildderefimpl;override;
  140. procedure derefimpl;override;
  141. function dogetcopy : tnode;override;
  142. function pass_typecheck:tnode;override;
  143. function pass_1 : tnode;override;
  144. function docompare(p: tnode): boolean; override;
  145. end;
  146. tlabelnodeclass = class of tlabelnode;
  147. traisenode = class(ttertiarynode)
  148. constructor create(l,taddr,tframe:tnode);virtual;
  149. function pass_typecheck:tnode;override;
  150. function pass_1 : tnode;override;
  151. end;
  152. traisenodeclass = class of traisenode;
  153. ttryexceptnode = class(tloopnode)
  154. constructor create(l,r,_t1 : tnode);virtual;reintroduce;
  155. function pass_typecheck:tnode;override;
  156. function pass_1 : tnode;override;
  157. end;
  158. ttryexceptnodeclass = class of ttryexceptnode;
  159. ttryfinallynode = class(tloopnode)
  160. implicitframe : boolean;
  161. constructor create(l,r:tnode);virtual;reintroduce;
  162. constructor create_implicit(l,r,_t1:tnode);virtual;
  163. function pass_typecheck:tnode;override;
  164. function pass_1 : tnode;override;
  165. function simplify: tnode;override;
  166. end;
  167. ttryfinallynodeclass = class of ttryfinallynode;
  168. tonnode = class(tbinarynode)
  169. excepTSymtable : TSymtable;
  170. excepttype : tobjectdef;
  171. constructor create(l,r:tnode);virtual;
  172. destructor destroy;override;
  173. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  174. function pass_typecheck:tnode;override;
  175. function pass_1 : tnode;override;
  176. function dogetcopy : tnode;override;
  177. function docompare(p: tnode): boolean; override;
  178. end;
  179. tonnodeclass = class of tonnode;
  180. var
  181. cwhilerepeatnode : twhilerepeatnodeclass;
  182. cifnode : tifnodeclass;
  183. cfornode : tfornodeclass;
  184. cexitnode : texitnodeclass;
  185. cbreaknode : tbreaknodeclass;
  186. ccontinuenode : tcontinuenodeclass;
  187. cgotonode : tgotonodeclass;
  188. clabelnode : tlabelnodeclass;
  189. craisenode : traisenodeclass;
  190. ctryexceptnode : ttryexceptnodeclass;
  191. ctryfinallynode : ttryfinallynodeclass;
  192. connode : tonnodeclass;
  193. // for-in loop helpers
  194. function create_type_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  195. function create_string_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  196. function create_array_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  197. function create_set_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  198. function create_enumerator_for_in_loop(hloopvar, hloopbody, expr: tnode;
  199. enumerator_get, enumerator_move: tprocdef; enumerator_current: tpropertysym): tnode;
  200. function create_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  201. implementation
  202. uses
  203. globtype,systems,constexp,
  204. cutils,verbose,globals,
  205. symconst,symtable,paramgr,defcmp,defutil,htypechk,pass_1,
  206. ncal,nadd,ncon,nmem,nld,ncnv,nbas,cgobj,nutils,ninl,nset,
  207. {$ifdef state_tracking}
  208. nstate,
  209. {$endif}
  210. cgbase,procinfo
  211. ;
  212. // for-in loop helpers
  213. function create_type_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  214. begin
  215. result:=cfornode.create(hloopvar,
  216. cinlinenode.create(in_low_x,false,expr.getcopy),
  217. cinlinenode.create(in_high_x,false,expr.getcopy),
  218. hloopbody,
  219. false);
  220. end;
  221. function create_objc_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  222. var
  223. mainstatement, outerloopbodystatement, innerloopbodystatement, tempstatement: tstatementnode;
  224. state, mutationcheck, currentamount, innerloopcounter, items, expressiontemp: ttempcreatenode;
  225. outerloop, innerloop, hp: tnode;
  226. itemsarraydef: tarraydef;
  227. sym: tsym;
  228. begin
  229. { Objective-C enumerators require Objective-C 2.0 }
  230. if not(m_objectivec2 in current_settings.modeswitches) then
  231. begin
  232. result:=cerrornode.create;
  233. MessagePos(expr.fileinfo,parser_e_objc_enumerator_2_0);
  234. exit;
  235. end;
  236. { Requires the NSFastEnumeration protocol and NSFastEnumerationState
  237. record }
  238. maybeloadcocoatypes;
  239. if not assigned(objc_fastenumeration) or
  240. not assigned(objc_fastenumerationstate) then
  241. begin
  242. result:=cerrornode.create;
  243. MessagePos(expr.fileinfo,parser_e_objc_missing_enumeration_defs);
  244. exit;
  245. end;
  246. (* Original code:
  247. for hloopvar in expression do
  248. <hloopbody>
  249. Pascal code equivalent into which it has to be transformed
  250. (sure would be nice if the compiler had some kind of templates ;) :
  251. var
  252. state: NSFastEnumerationState;
  253. expressiontemp: NSFastEnumerationProtocol;
  254. mutationcheck,
  255. currentamount,
  256. innerloopcounter: culong;
  257. { size can be increased/decreased if desired }
  258. items: array[1..16] of id;
  259. begin
  260. fillchar(state,sizeof(state),0);
  261. expressiontemp:=expression;
  262. repeat
  263. currentamount:=expressiontemp.countByEnumeratingWithState_objects_count(@state,@items,length(items));
  264. if currentamount=0 then
  265. begin
  266. { "The iterating variable is set to nil when the loop ends by
  267. exhausting the source pool of objects" }
  268. hloopvar:=nil;
  269. break;
  270. end;
  271. mutationcheck:=state.mutationsptr^;
  272. innerloopcounter:=culong(-1);
  273. repeat
  274. { at the start so that "continue" in <loopbody> works correctly }
  275. { don't use for-loop, because then the value of the iteration
  276. counter is undefined on exit and we have to check it in the
  277. outer repeat/until condition }
  278. {$push}
  279. {$r-,q-}
  280. inc(innerloopcounter);
  281. {$pop}
  282. if innerloopcounter=currentamount then
  283. break;
  284. if mutationcheck<>state.mutationsptr^ then
  285. { raises Objective-C exception... }
  286. objc_enumerationMutation(expressiontemp);
  287. hloopvar:=state.itemsPtr[innerloopcounter];
  288. { if continue in loopbody -> jumps to start, increases count and checks }
  289. { if break in loopbody: goes to outer repeat/until and innerloopcount
  290. will be < currentamount -> stops }
  291. <hloopbody>
  292. until false;
  293. { if the inner loop terminated early, "break" was used and we have
  294. to stop }
  295. { "If the loop is terminated early, the iterating variable is left
  296. pointing to the last iteration item." }
  297. until innerloopcounter<currentamount;
  298. end;
  299. *)
  300. result:=internalstatements(mainstatement);
  301. { the fast enumeration state }
  302. state:=ctempcreatenode.create(objc_fastenumerationstate,objc_fastenumerationstate.size,tt_persistent,false);
  303. typecheckpass(tnode(state));
  304. addstatement(mainstatement,state);
  305. { the temporary items array }
  306. itemsarraydef:=tarraydef.create(1,16,u32inttype);
  307. itemsarraydef.elementdef:=objc_idtype;
  308. items:=ctempcreatenode.create(itemsarraydef,itemsarraydef.size,tt_persistent,false);
  309. addstatement(mainstatement,items);
  310. typecheckpass(tnode(items));
  311. { temp for the expression/collection through which we iterate }
  312. expressiontemp:=ctempcreatenode.create(objc_fastenumeration,objc_fastenumeration.size,tt_persistent,true);
  313. addstatement(mainstatement,expressiontemp);
  314. { currentamount temp (not really clean: we use ptruint instead of
  315. culong) }
  316. currentamount:=ctempcreatenode.create(ptruinttype,ptruinttype.size,tt_persistent,true);
  317. typecheckpass(tnode(currentamount));
  318. addstatement(mainstatement,currentamount);
  319. { mutationcheck temp (idem) }
  320. mutationcheck:=ctempcreatenode.create(ptruinttype,ptruinttype.size,tt_persistent,true);
  321. typecheckpass(tnode(mutationcheck));
  322. addstatement(mainstatement,mutationcheck);
  323. { innerloopcounter temp (idem) }
  324. innerloopcounter:=ctempcreatenode.create(ptruinttype,ptruinttype.size,tt_persistent,true);
  325. typecheckpass(tnode(innerloopcounter));
  326. addstatement(mainstatement,innerloopcounter);
  327. { initialise the state with 0 }
  328. addstatement(mainstatement,ccallnode.createinternfromunit('SYSTEM','FILLCHAR',
  329. ccallparanode.create(genintconstnode(0),
  330. ccallparanode.create(genintconstnode(objc_fastenumerationstate.size),
  331. ccallparanode.create(ctemprefnode.create(state),nil)
  332. )
  333. )
  334. ));
  335. { this will also check whether the expression (potentially) conforms
  336. to the NSFastEnumeration protocol (use expr.getcopy, because the
  337. caller will free expr) }
  338. addstatement(mainstatement,cassignmentnode.create(ctemprefnode.create(expressiontemp),expr.getcopy));
  339. { we add the "repeat..until" afterwards, now just create the body }
  340. outerloop:=internalstatements(outerloopbodystatement);
  341. { the countByEnumeratingWithState_objects_count call }
  342. hp:=ccallparanode.create(cinlinenode.create(in_length_x,false,ctypenode.create(itemsarraydef)),
  343. ccallparanode.create(caddrnode.create(ctemprefnode.create(items)),
  344. ccallparanode.create(caddrnode.create(ctemprefnode.create(state)),nil)
  345. )
  346. );
  347. sym:=search_class_member(objc_fastenumeration,'COUNTBYENUMERATINGWITHSTATE_OBJECTS_COUNT');
  348. if not assigned(sym) or
  349. (sym.typ<>procsym) then
  350. internalerror(2010061901);
  351. hp:=ccallnode.create(hp,tprocsym(sym),sym.owner,ctemprefnode.create(expressiontemp),[]);
  352. addstatement(outerloopbodystatement,cassignmentnode.create(
  353. ctemprefnode.create(currentamount),hp));
  354. { if currentamount = 0, bail out (use copy of hloopvar, because we
  355. have to use it again below) }
  356. hp:=internalstatements(tempstatement);
  357. addstatement(tempstatement,cassignmentnode.create(
  358. hloopvar.getcopy,cnilnode.create));
  359. addstatement(tempstatement,cbreaknode.create);
  360. addstatement(outerloopbodystatement,cifnode.create(
  361. caddnode.create(equaln,ctemprefnode.create(currentamount),genintconstnode(0)),
  362. hp,nil));
  363. { initial value of mutationcheck }
  364. hp:=ctemprefnode.create(state);
  365. typecheckpass(hp);
  366. hp:=cderefnode.create(genloadfield(hp,'MUTATIONSPTR'));
  367. addstatement(outerloopbodystatement,cassignmentnode.create(
  368. ctemprefnode.create(mutationcheck),hp));
  369. { initialise innerloopcounter }
  370. addstatement(outerloopbodystatement,cassignmentnode.create(
  371. ctemprefnode.create(innerloopcounter),cordconstnode.create(-1,ptruinttype,false)));
  372. { and now the inner loop, again adding the repeat/until afterwards }
  373. innerloop:=internalstatements(innerloopbodystatement);
  374. { inc(innerloopcounter) without range/overflowchecking (because
  375. we go from culong(-1) to 0 during the first iteration }
  376. hp:=cinlinenode.create(
  377. in_inc_x,false,ccallparanode.create(
  378. ctemprefnode.create(innerloopcounter),nil));
  379. hp.localswitches:=hp.localswitches-[cs_check_range,cs_check_overflow];
  380. addstatement(innerloopbodystatement,hp);
  381. { if innerloopcounter=currentamount then break to the outer loop }
  382. addstatement(innerloopbodystatement,cifnode.create(
  383. caddnode.create(equaln,
  384. ctemprefnode.create(innerloopcounter),
  385. ctemprefnode.create(currentamount)),
  386. cbreaknode.create,
  387. nil));
  388. { verify that the collection didn't change in the mean time }
  389. hp:=ctemprefnode.create(state);
  390. typecheckpass(hp);
  391. addstatement(innerloopbodystatement,cifnode.create(
  392. caddnode.create(unequaln,
  393. ctemprefnode.create(mutationcheck),
  394. cderefnode.create(genloadfield(hp,'MUTATIONSPTR'))
  395. ),
  396. ccallnode.createinternfromunit('OBJC','OBJC_ENUMERATIONMUTATION',
  397. ccallparanode.create(ctemprefnode.create(expressiontemp),nil)),
  398. nil));
  399. { finally: actually get the next element }
  400. hp:=ctemprefnode.create(state);
  401. typecheckpass(hp);
  402. hp:=genloadfield(hp,'ITEMSPTR');
  403. typecheckpass(hp);
  404. { don't simply use a vecn, because indexing a pointer won't work in
  405. non-FPC modes }
  406. if hp.resultdef.typ<>pointerdef then
  407. internalerror(2010061904);
  408. inserttypeconv(hp,
  409. tarraydef.create_from_pointer(tpointerdef(hp.resultdef).pointeddef));
  410. hp:=cvecnode.create(hp,ctemprefnode.create(innerloopcounter));
  411. addstatement(innerloopbodystatement,
  412. cassignmentnode.create(hloopvar,hp));
  413. { the actual loop body! }
  414. addstatement(innerloopbodystatement,hloopbody);
  415. { create the inner repeat/until and add it to the body of the outer
  416. one }
  417. hp:=cwhilerepeatnode.create(
  418. { repeat .. until false }
  419. cordconstnode.create(0,booltype,false),innerloop,false,true);
  420. addstatement(outerloopbodystatement,hp);
  421. { create the outer repeat/until and add it to the the main body }
  422. hp:=cwhilerepeatnode.create(
  423. { repeat .. until innerloopcounter<currentamount }
  424. caddnode.create(ltn,
  425. ctemprefnode.create(innerloopcounter),
  426. ctemprefnode.create(currentamount)),
  427. outerloop,false,true);
  428. addstatement(mainstatement,hp);
  429. { release the temps }
  430. addstatement(mainstatement,ctempdeletenode.create(state));
  431. addstatement(mainstatement,ctempdeletenode.create(mutationcheck));
  432. addstatement(mainstatement,ctempdeletenode.create(currentamount));
  433. addstatement(mainstatement,ctempdeletenode.create(innerloopcounter));
  434. addstatement(mainstatement,ctempdeletenode.create(items));
  435. addstatement(mainstatement,ctempdeletenode.create(expressiontemp));
  436. end;
  437. function create_string_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  438. var
  439. loopstatement, loopbodystatement: tstatementnode;
  440. loopvar, stringvar: ttempcreatenode;
  441. stringindex, loopbody, forloopnode: tnode;
  442. begin
  443. { result is a block of statements }
  444. result:=internalstatements(loopstatement);
  445. { create a temp variable for expression }
  446. stringvar := ctempcreatenode.create(
  447. expr.resultdef,
  448. expr.resultdef.size,
  449. tt_persistent,true);
  450. addstatement(loopstatement,stringvar);
  451. addstatement(loopstatement,cassignmentnode.create(ctemprefnode.create(stringvar),expr.getcopy));
  452. { create a loop counter: signed integer with size of string length }
  453. loopvar := ctempcreatenode.create(
  454. sinttype,
  455. sinttype.size,
  456. tt_persistent,true);
  457. addstatement(loopstatement,loopvar);
  458. stringindex:=ctemprefnode.create(loopvar);
  459. loopbody:=internalstatements(loopbodystatement);
  460. // for-in loop variable := string_expression[index]
  461. addstatement(loopbodystatement,
  462. cassignmentnode.create(hloopvar, cvecnode.create(ctemprefnode.create(stringvar),stringindex)));
  463. { add the actual statement to the loop }
  464. addstatement(loopbodystatement,hloopbody);
  465. forloopnode:=cfornode.create(ctemprefnode.create(loopvar),
  466. genintconstnode(1),
  467. cinlinenode.create(in_length_x,false,ctemprefnode.create(stringvar)),
  468. loopbody,
  469. false);
  470. addstatement(loopstatement,forloopnode);
  471. { free the loop counter }
  472. addstatement(loopstatement,ctempdeletenode.create(loopvar));
  473. { free the temp variable for expression }
  474. addstatement(loopstatement,ctempdeletenode.create(stringvar));
  475. end;
  476. function create_array_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  477. var
  478. loopstatement, loopbodystatement: tstatementnode;
  479. loopvar, arrayvar: ttempcreatenode;
  480. arrayindex, lowbound, highbound, loopbody, forloopnode, expression: tnode;
  481. is_string: boolean;
  482. tmpdef, convertdef: tdef;
  483. elementcount: aword;
  484. begin
  485. expression := expr;
  486. { result is a block of statements }
  487. result:=internalstatements(loopstatement);
  488. is_string:=ado_IsConstString in tarraydef(expr.resultdef).arrayoptions;
  489. // if array element type <> loovar type then create a conversion if possible
  490. if compare_defs(tarraydef(expression.resultdef).elementdef,hloopvar.resultdef,nothingn)=te_incompatible then
  491. begin
  492. tmpdef:=expression.resultdef;
  493. elementcount:=1;
  494. while assigned(tmpdef) and (tmpdef.typ=arraydef) and
  495. (tarraydef(tmpdef).arrayoptions = []) and
  496. (compare_defs(tarraydef(tmpdef).elementdef,hloopvar.resultdef,nothingn)=te_incompatible) do
  497. begin
  498. elementcount:=elementcount*tarraydef(tmpdef).elecount;
  499. tmpdef:=tarraydef(tmpdef).elementdef;
  500. end;
  501. if assigned(tmpdef) and (tmpdef.typ=arraydef) and (tarraydef(tmpdef).arrayoptions = []) then
  502. begin
  503. elementcount:=elementcount*tarraydef(tmpdef).elecount;
  504. convertdef:=tarraydef.create(0,elementcount-1,s32inttype);
  505. tarraydef(convertdef).elementdef:=tarraydef(tmpdef).elementdef;
  506. expression:=expr.getcopy;
  507. expression:=ctypeconvnode.create_internal(expression,convertdef);
  508. typecheckpass(expression);
  509. addstatement(loopstatement,expression);
  510. end;
  511. end;
  512. if (node_complexity(expression) > 1) and not is_open_array(expression.resultdef) then
  513. begin
  514. { create a temp variable for expression }
  515. arrayvar := ctempcreatenode.create(
  516. expression.resultdef,
  517. expression.resultdef.size,
  518. tt_persistent,true);
  519. if is_string then
  520. begin
  521. lowbound:=genintconstnode(1);
  522. highbound:=cinlinenode.create(in_length_x,false,ctemprefnode.create(arrayvar))
  523. end
  524. else
  525. begin
  526. lowbound:=cinlinenode.create(in_low_x,false,ctemprefnode.create(arrayvar));
  527. highbound:=cinlinenode.create(in_high_x,false,ctemprefnode.create(arrayvar));
  528. end;
  529. addstatement(loopstatement,arrayvar);
  530. addstatement(loopstatement,cassignmentnode.create(ctemprefnode.create(arrayvar),expression.getcopy));
  531. end
  532. else
  533. begin
  534. arrayvar:=nil;
  535. if is_string then
  536. begin
  537. lowbound:=genintconstnode(1);
  538. highbound:=cinlinenode.create(in_length_x,false,expression.getcopy);
  539. end
  540. else
  541. begin
  542. lowbound:=cinlinenode.create(in_low_x,false,expression.getcopy);
  543. highbound:=cinlinenode.create(in_high_x,false,expression.getcopy);
  544. end;
  545. end;
  546. { create a loop counter }
  547. loopvar := ctempcreatenode.create(
  548. tarraydef(expression.resultdef).rangedef,
  549. tarraydef(expression.resultdef).rangedef.size,
  550. tt_persistent,true);
  551. addstatement(loopstatement,loopvar);
  552. arrayindex:=ctemprefnode.create(loopvar);
  553. loopbody:=internalstatements(loopbodystatement);
  554. // for-in loop variable := array_expression[index]
  555. if assigned(arrayvar) then
  556. addstatement(loopbodystatement,
  557. cassignmentnode.create(hloopvar,cvecnode.create(ctemprefnode.create(arrayvar),arrayindex)))
  558. else
  559. addstatement(loopbodystatement,
  560. cassignmentnode.create(hloopvar,cvecnode.create(expression.getcopy,arrayindex)));
  561. { add the actual statement to the loop }
  562. addstatement(loopbodystatement,hloopbody);
  563. forloopnode:=cfornode.create(ctemprefnode.create(loopvar),
  564. lowbound,
  565. highbound,
  566. loopbody,
  567. false);
  568. addstatement(loopstatement,forloopnode);
  569. { free the loop counter }
  570. addstatement(loopstatement,ctempdeletenode.create(loopvar));
  571. { free the temp variable for expression if needed }
  572. if arrayvar<>nil then
  573. addstatement(loopstatement,ctempdeletenode.create(arrayvar));
  574. end;
  575. function create_set_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  576. var
  577. loopstatement, loopbodystatement: tstatementnode;
  578. loopvar, setvar: ttempcreatenode;
  579. loopbody, forloopnode: tnode;
  580. begin
  581. // first check is set is empty and if it so then skip other processing
  582. if not Assigned(tsetdef(expr.resultdef).elementdef) then
  583. begin
  584. result:=cnothingnode.create;
  585. // free unused nodes
  586. hloopvar.free;
  587. hloopbody.free;
  588. exit;
  589. end;
  590. { result is a block of statements }
  591. result:=internalstatements(loopstatement);
  592. { create a temp variable for expression }
  593. setvar := ctempcreatenode.create(
  594. expr.resultdef,
  595. expr.resultdef.size,
  596. tt_persistent,true);
  597. addstatement(loopstatement,setvar);
  598. addstatement(loopstatement,cassignmentnode.create(ctemprefnode.create(setvar),expr.getcopy));
  599. { create a loop counter }
  600. loopvar := ctempcreatenode.create(
  601. tsetdef(expr.resultdef).elementdef,
  602. tsetdef(expr.resultdef).elementdef.size,
  603. tt_persistent,true);
  604. addstatement(loopstatement,loopvar);
  605. // if loopvar in set then
  606. // begin
  607. // hloopvar := loopvar
  608. // for-in loop body
  609. // end
  610. loopbody:=cifnode.create(
  611. cinnode.create(ctemprefnode.create(loopvar),ctemprefnode.create(setvar)),
  612. internalstatements(loopbodystatement),
  613. nil);
  614. addstatement(loopbodystatement,cassignmentnode.create(hloopvar,ctemprefnode.create(loopvar)));
  615. { add the actual statement to the loop }
  616. addstatement(loopbodystatement,hloopbody);
  617. forloopnode:=cfornode.create(ctemprefnode.create(loopvar),
  618. cinlinenode.create(in_low_x,false,ctemprefnode.create(setvar)),
  619. cinlinenode.create(in_high_x,false,ctemprefnode.create(setvar)),
  620. loopbody,
  621. false);
  622. addstatement(loopstatement,forloopnode);
  623. { free the loop counter }
  624. addstatement(loopstatement,ctempdeletenode.create(loopvar));
  625. { free the temp variable for expression }
  626. addstatement(loopstatement,ctempdeletenode.create(setvar));
  627. end;
  628. function create_enumerator_for_in_loop(hloopvar, hloopbody, expr: tnode;
  629. enumerator_get, enumerator_move: tprocdef; enumerator_current: tpropertysym): tnode;
  630. var
  631. loopstatement, loopbodystatement: tstatementnode;
  632. enumvar: ttempcreatenode;
  633. loopbody, whileloopnode,
  634. enum_get, enum_move, enum_current, enum_get_params: tnode;
  635. propaccesslist: tpropaccesslist;
  636. enumerator_is_class: boolean;
  637. enumerator_destructor: tprocdef;
  638. begin
  639. { result is a block of statements }
  640. result:=internalstatements(loopstatement);
  641. enumerator_is_class := is_class(enumerator_get.returndef);
  642. { create a temp variable for enumerator }
  643. enumvar := ctempcreatenode.create(
  644. enumerator_get.returndef,
  645. enumerator_get.returndef.size,
  646. tt_persistent,true);
  647. addstatement(loopstatement,enumvar);
  648. if enumerator_get.proctypeoption=potype_operator then
  649. begin
  650. enum_get_params:=ccallparanode.create(expr.getcopy,nil);
  651. enum_get:=ccallnode.create(enum_get_params, tprocsym(enumerator_get.procsym), nil, nil, []);
  652. tcallnode(enum_get).procdefinition:=enumerator_get;
  653. addsymref(enumerator_get.procsym);
  654. end
  655. else
  656. enum_get:=ccallnode.create(nil, tprocsym(enumerator_get.procsym), enumerator_get.owner, expr.getcopy, []);
  657. addstatement(loopstatement,
  658. cassignmentnode.create(
  659. ctemprefnode.create(enumvar),
  660. enum_get
  661. ));
  662. loopbody:=internalstatements(loopbodystatement);
  663. { for-in loop variable := enumerator.current }
  664. if getpropaccesslist(enumerator_current,palt_read,propaccesslist) then
  665. begin
  666. case propaccesslist.firstsym^.sym.typ of
  667. fieldvarsym :
  668. begin
  669. { generate access code }
  670. enum_current:=ctemprefnode.create(enumvar);
  671. propaccesslist_to_node(enum_current,enumerator_current.owner,propaccesslist);
  672. include(enum_current.flags,nf_isproperty);
  673. end;
  674. procsym :
  675. begin
  676. { generate the method call }
  677. enum_current:=ccallnode.create(nil,tprocsym(propaccesslist.firstsym^.sym),enumerator_current.owner,ctemprefnode.create(enumvar),[]);
  678. include(enum_current.flags,nf_isproperty);
  679. end
  680. else
  681. begin
  682. enum_current:=cerrornode.create;
  683. Message(type_e_mismatch);
  684. end;
  685. end;
  686. end
  687. else
  688. enum_current:=cerrornode.create;
  689. addstatement(loopbodystatement,
  690. cassignmentnode.create(hloopvar, enum_current));
  691. { add the actual statement to the loop }
  692. addstatement(loopbodystatement,hloopbody);
  693. enum_move:=ccallnode.create(nil, tprocsym(enumerator_move.procsym), enumerator_move.owner, ctemprefnode.create(enumvar), []);
  694. whileloopnode:=cwhilerepeatnode.create(enum_move,loopbody,true,false);
  695. if enumerator_is_class then
  696. begin
  697. { insert a try-finally and call the destructor for the enumerator in the finally section }
  698. enumerator_destructor:=tobjectdef(enumerator_get.returndef).find_destructor;
  699. if assigned(enumerator_destructor) then
  700. begin
  701. whileloopnode:=ctryfinallynode.create(
  702. whileloopnode, // try node
  703. ccallnode.create(nil,tprocsym(enumerator_destructor.procsym), // finally node
  704. enumerator_destructor.procsym.owner,ctemprefnode.create(enumvar),[]));
  705. end;
  706. { if getenumerator <> nil then do the loop }
  707. whileloopnode:=cifnode.create(
  708. caddnode.create(unequaln, ctemprefnode.create(enumvar), cnilnode.create),
  709. whileloopnode,
  710. nil);
  711. end;
  712. addstatement(loopstatement, whileloopnode);
  713. if is_object(enumerator_get.returndef) then
  714. begin
  715. // call the object destructor too
  716. enumerator_destructor:=tobjectdef(enumerator_get.returndef).find_destructor;
  717. if assigned(enumerator_destructor) then
  718. begin
  719. addstatement(loopstatement,
  720. ccallnode.create(nil,tprocsym(enumerator_destructor.procsym),
  721. enumerator_destructor.procsym.owner,ctemprefnode.create(enumvar),[]));
  722. end;
  723. end;
  724. { free the temp variable for enumerator }
  725. addstatement(loopstatement,ctempdeletenode.create(enumvar));
  726. end;
  727. function create_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  728. var
  729. pd, movenext: tprocdef;
  730. current: tpropertysym;
  731. storefilepos: tfileposinfo;
  732. begin
  733. storefilepos:=current_filepos;
  734. current_filepos:=hloopvar.fileinfo;
  735. if expr.nodetype=typen then
  736. begin
  737. if (expr.resultdef.typ=enumdef) and tenumdef(expr.resultdef).has_jumps then
  738. begin
  739. result:=cerrornode.create;
  740. hloopvar.free;
  741. hloopbody.free;
  742. MessagePos1(expr.fileinfo,parser_e_for_in_loop_cannot_be_used_for_the_type,expr.resultdef.typename);
  743. end
  744. else
  745. result:=create_type_for_in_loop(hloopvar, hloopbody, expr);
  746. end
  747. else
  748. begin
  749. { loop is made for an expression }
  750. // Objective-C uses different conventions (and it's only supported for Objective-C 2.0)
  751. if is_objc_class_or_protocol(hloopvar.resultdef) or
  752. is_objc_class_or_protocol(expr.resultdef) then
  753. begin
  754. result:=create_objc_for_in_loop(hloopvar,hloopbody,expr);
  755. if result.nodetype=errorn then
  756. begin
  757. hloopvar.free;
  758. hloopbody.free;
  759. end;
  760. end
  761. else
  762. begin
  763. // search for operator first
  764. pd:=search_enumerator_operator(expr.resultdef);
  765. // if there is no operator then search for class/object enumerator method
  766. if (pd=nil) and (expr.resultdef.typ=objectdef) then
  767. pd:=tobjectdef(expr.resultdef).search_enumerator_get;
  768. if pd<>nil then
  769. begin
  770. // seach movenext and current symbols
  771. movenext:=tobjectdef(pd.returndef).search_enumerator_move;
  772. if movenext = nil then
  773. begin
  774. result:=cerrornode.create;
  775. hloopvar.free;
  776. hloopbody.free;
  777. MessagePos1(expr.fileinfo,sym_e_no_enumerator_move,pd.returndef.GetTypeName);
  778. end
  779. else
  780. begin
  781. current:=tpropertysym(tobjectdef(pd.returndef).search_enumerator_current);
  782. if current = nil then
  783. begin
  784. result:=cerrornode.create;
  785. hloopvar.free;
  786. hloopbody.free;
  787. MessagePos1(expr.fileinfo,sym_e_no_enumerator_current,pd.returndef.GetTypeName);
  788. end
  789. else
  790. result:=create_enumerator_for_in_loop(hloopvar, hloopbody, expr, pd, movenext, current);
  791. end;
  792. end
  793. else
  794. begin
  795. case expr.resultdef.typ of
  796. stringdef: result:=create_string_for_in_loop(hloopvar, hloopbody, expr);
  797. arraydef: result:=create_array_for_in_loop(hloopvar, hloopbody, expr);
  798. setdef: result:=create_set_for_in_loop(hloopvar, hloopbody, expr);
  799. else
  800. begin
  801. result:=cerrornode.create;
  802. hloopvar.free;
  803. hloopbody.free;
  804. MessagePos1(expr.fileinfo,sym_e_no_enumerator,expr.resultdef.GetTypeName);
  805. end;
  806. end;
  807. end;
  808. end;
  809. end;
  810. current_filepos:=storefilepos;
  811. end;
  812. {****************************************************************************
  813. TLOOPNODE
  814. *****************************************************************************}
  815. constructor tloopnode.create(tt : tnodetype;l,r,_t1,_t2 : tnode);
  816. begin
  817. inherited create(tt,l,r);
  818. t1:=_t1;
  819. t2:=_t2;
  820. fileinfo:=l.fileinfo;
  821. end;
  822. destructor tloopnode.destroy;
  823. begin
  824. t1.free;
  825. t2.free;
  826. inherited destroy;
  827. end;
  828. constructor tloopnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  829. begin
  830. inherited ppuload(t,ppufile);
  831. t1:=ppuloadnode(ppufile);
  832. t2:=ppuloadnode(ppufile);
  833. end;
  834. procedure tloopnode.ppuwrite(ppufile:tcompilerppufile);
  835. begin
  836. inherited ppuwrite(ppufile);
  837. ppuwritenode(ppufile,t1);
  838. ppuwritenode(ppufile,t2);
  839. end;
  840. procedure tloopnode.buildderefimpl;
  841. begin
  842. inherited buildderefimpl;
  843. if assigned(t1) then
  844. t1.buildderefimpl;
  845. if assigned(t2) then
  846. t2.buildderefimpl;
  847. end;
  848. procedure tloopnode.derefimpl;
  849. begin
  850. inherited derefimpl;
  851. if assigned(t1) then
  852. t1.derefimpl;
  853. if assigned(t2) then
  854. t2.derefimpl;
  855. end;
  856. function tloopnode.dogetcopy : tnode;
  857. var
  858. p : tloopnode;
  859. begin
  860. p:=tloopnode(inherited dogetcopy);
  861. if assigned(t1) then
  862. p.t1:=t1.dogetcopy
  863. else
  864. p.t1:=nil;
  865. if assigned(t2) then
  866. p.t2:=t2.dogetcopy
  867. else
  868. p.t2:=nil;
  869. p.loopflags:=loopflags;
  870. dogetcopy:=p;
  871. end;
  872. procedure tloopnode.insertintolist(l : tnodelist);
  873. begin
  874. end;
  875. procedure tloopnode.printnodetree(var t:text);
  876. begin
  877. write(t,printnodeindention,'(');
  878. printnodeindent;
  879. printnodeinfo(t);
  880. writeln(t);
  881. printnode(t,left);
  882. printnode(t,right);
  883. printnode(t,t1);
  884. printnode(t,t2);
  885. printnodeunindent;
  886. writeln(t,printnodeindention,')');
  887. end;
  888. function tloopnode.docompare(p: tnode): boolean;
  889. begin
  890. docompare :=
  891. inherited docompare(p) and
  892. (loopflags*loopflagsequal=tloopnode(p).loopflags*loopflagsequal) and
  893. t1.isequal(tloopnode(p).t1) and
  894. t2.isequal(tloopnode(p).t2);
  895. end;
  896. {****************************************************************************
  897. TWHILEREPEATNODE
  898. *****************************************************************************}
  899. constructor Twhilerepeatnode.create(l,r:Tnode;tab,cn:boolean);
  900. begin
  901. inherited create(whilerepeatn,l,r,nil,nil);
  902. if tab then
  903. include(loopflags, lnf_testatbegin);
  904. if cn then
  905. include(loopflags,lnf_checknegate);
  906. end;
  907. function twhilerepeatnode.pass_typecheck:tnode;
  908. var
  909. t:Tunarynode;
  910. begin
  911. result:=nil;
  912. resultdef:=voidtype;
  913. typecheckpass(left);
  914. { tp procvar support }
  915. maybe_call_procvar(left,true);
  916. {A not node can be removed.}
  917. if left.nodetype=notn then
  918. begin
  919. t:=Tunarynode(left);
  920. left:=Tunarynode(left).left;
  921. t.left:=nil;
  922. t.destroy;
  923. {Symdif operator, in case you are wondering:}
  924. loopflags:=loopflags >< [lnf_checknegate];
  925. end;
  926. { loop instruction }
  927. if assigned(right) then
  928. typecheckpass(right);
  929. set_varstate(left,vs_read,[vsf_must_be_valid]);
  930. if codegenerror then
  931. exit;
  932. if not is_boolean(left.resultdef) then
  933. begin
  934. if left.resultdef.typ=variantdef then
  935. inserttypeconv(left,booltype)
  936. else
  937. CGMessage1(type_e_boolean_expr_expected,left.resultdef.typename);
  938. end;
  939. { Give warnings for code that will never be executed for
  940. while false do }
  941. if (lnf_testatbegin in loopflags) and
  942. (left.nodetype=ordconstn) and
  943. (tordconstnode(left).value.uvalue=0) and
  944. assigned(right) then
  945. CGMessagePos(right.fileinfo,cg_w_unreachable_code);
  946. end;
  947. {$ifdef prefetchnext}
  948. type
  949. passignmentquery = ^tassignmentquery;
  950. tassignmentquery = record
  951. towhat: tnode;
  952. source: tassignmentnode;
  953. statementcount: cardinal;
  954. end;
  955. function checkassignment(var n: tnode; arg: pointer): foreachnoderesult;
  956. var
  957. query: passignmentquery absolute arg;
  958. temp, prederef: tnode;
  959. begin
  960. result := fen_norecurse_false;
  961. if (n.nodetype in [assignn,inlinen,forn,calln,whilerepeatn,casen,ifn]) then
  962. inc(query^.statementcount);
  963. { make sure there's something else in the loop besides going to the }
  964. { next item }
  965. if (query^.statementcount > 1) and
  966. (n.nodetype = assignn) then
  967. begin
  968. { skip type conversions of assignment target }
  969. temp := tassignmentnode(n).left;
  970. while (temp.nodetype = typeconvn) do
  971. temp := ttypeconvnode(temp).left;
  972. { assignment to x of the while assigned(x) check? }
  973. if not(temp.isequal(query^.towhat)) then
  974. exit;
  975. { right hand side of assignment dereferenced field of }
  976. { x? (no derefn in case of class) }
  977. temp := tassignmentnode(n).right;
  978. while (temp.nodetype = typeconvn) do
  979. temp := ttypeconvnode(temp).left;
  980. if (temp.nodetype <> subscriptn) then
  981. exit;
  982. prederef := tsubscriptnode(temp).left;
  983. temp := prederef;
  984. while (temp.nodetype = typeconvn) do
  985. temp := ttypeconvnode(temp).left;
  986. { see tests/test/prefetch1.pp }
  987. if (temp.nodetype = derefn) then
  988. temp := tderefnode(temp).left
  989. else
  990. temp := prederef;
  991. if temp.isequal(query^.towhat) then
  992. begin
  993. query^.source := tassignmentnode(n);
  994. result := fen_norecurse_true;
  995. end
  996. end
  997. { don't check nodes which can't contain an assignment or whose }
  998. { final assignment can vary a lot }
  999. else if not(n.nodetype in [calln,inlinen,casen,whilerepeatn,forn]) then
  1000. result := fen_false;
  1001. end;
  1002. function findassignment(where: tnode; towhat: tnode): tassignmentnode;
  1003. var
  1004. query: tassignmentquery;
  1005. begin
  1006. query.towhat := towhat;
  1007. query.source := nil;
  1008. query.statementcount := 0;
  1009. if foreachnodestatic(where,@checkassignment,@query) then
  1010. result := query.source
  1011. else
  1012. result := nil;
  1013. end;
  1014. {$endif prefetchnext}
  1015. function twhilerepeatnode.pass_1 : tnode;
  1016. {$ifdef prefetchnext}
  1017. var
  1018. runnernode, prefetchcode: tnode;
  1019. assignmentnode: tassignmentnode;
  1020. prefetchstatements: tstatementnode;
  1021. {$endif prefetchnext}
  1022. begin
  1023. result:=nil;
  1024. expectloc:=LOC_VOID;
  1025. firstpass(left);
  1026. if codegenerror then
  1027. exit;
  1028. { loop instruction }
  1029. if assigned(right) then
  1030. begin
  1031. firstpass(right);
  1032. if codegenerror then
  1033. exit;
  1034. end;
  1035. {$ifdef prefetchnext}
  1036. { do at the end so all complex typeconversions are already }
  1037. { converted to calln's }
  1038. if (cs_opt_level1 in current_settings.optimizerswitches) and
  1039. (lnf_testatbegin in loopflags) then
  1040. begin
  1041. { get first component of the while check }
  1042. runnernode := left;
  1043. while (runnernode.nodetype in [andn,orn,notn,xorn,typeconvn]) do
  1044. runnernode := tunarynode(runnernode).left;
  1045. { is it an assigned(x) check? }
  1046. if ((runnernode.nodetype = inlinen) and
  1047. (tinlinenode(runnernode).inlinenumber = in_assigned_x)) or
  1048. ((runnernode.nodetype = unequaln) and
  1049. (taddnode(runnernode).right.nodetype = niln)) then
  1050. begin
  1051. runnernode := tunarynode(runnernode).left;
  1052. { in case of in_assigned_x, there's a callparan in between }
  1053. if (runnernode.nodetype = callparan) then
  1054. runnernode := tcallparanode(runnernode).left;
  1055. while (runnernode.nodetype = typeconvn) do
  1056. runnernode := ttypeconvnode(runnernode).left;
  1057. { is there an "x := x(^).somefield"? }
  1058. assignmentnode := findassignment(right,runnernode);
  1059. if assigned(assignmentnode) then
  1060. begin
  1061. prefetchcode := internalstatements(prefetchstatements);
  1062. addstatement(prefetchstatements,geninlinenode(in_prefetch_var,false,
  1063. cderefnode.create(ctypeconvnode.create(assignmentnode.right.getcopy,voidpointertype))));
  1064. addstatement(prefetchstatements,right);
  1065. right := prefetchcode;
  1066. typecheckpass(right);
  1067. end;
  1068. end;
  1069. end;
  1070. {$endif prefetchnext}
  1071. end;
  1072. {$ifdef state_tracking}
  1073. function Twhilerepeatnode.track_state_pass(exec_known:boolean):boolean;
  1074. var condition:Tnode;
  1075. code:Tnode;
  1076. done:boolean;
  1077. value:boolean;
  1078. change:boolean;
  1079. firsttest:boolean;
  1080. factval:Tnode;
  1081. begin
  1082. track_state_pass:=false;
  1083. done:=false;
  1084. firsttest:=true;
  1085. {For repeat until statements, first do a pass through the code.}
  1086. if not(lnf_testatbegin in flags) then
  1087. begin
  1088. code:=right.getcopy;
  1089. if code.track_state_pass(exec_known) then
  1090. track_state_pass:=true;
  1091. code.destroy;
  1092. end;
  1093. repeat
  1094. condition:=left.getcopy;
  1095. code:=right.getcopy;
  1096. change:=condition.track_state_pass(exec_known);
  1097. factval:=aktstate.find_fact(left);
  1098. if factval<>nil then
  1099. begin
  1100. condition.destroy;
  1101. condition:=factval.getcopy;
  1102. change:=true;
  1103. end;
  1104. if change then
  1105. begin
  1106. track_state_pass:=true;
  1107. {Force new resultdef pass.}
  1108. condition.resultdef:=nil;
  1109. do_typecheckpass(condition);
  1110. end;
  1111. if is_constboolnode(condition) then
  1112. begin
  1113. {Try to turn a while loop into a repeat loop.}
  1114. if firsttest then
  1115. exclude(flags,testatbegin);
  1116. value:=(Tordconstnode(condition).value<>0) xor checknegate;
  1117. if value then
  1118. begin
  1119. if code.track_state_pass(exec_known) then
  1120. track_state_pass:=true;
  1121. end
  1122. else
  1123. done:=true;
  1124. end
  1125. else
  1126. begin
  1127. {Remove any modified variables from the state.}
  1128. code.track_state_pass(false);
  1129. done:=true;
  1130. end;
  1131. code.destroy;
  1132. condition.destroy;
  1133. firsttest:=false;
  1134. until done;
  1135. {The loop condition is also known, for example:
  1136. while i<10 do
  1137. begin
  1138. ...
  1139. end;
  1140. When the loop is done, we do know that i<10 = false.
  1141. }
  1142. condition:=left.getcopy;
  1143. if condition.track_state_pass(exec_known) then
  1144. begin
  1145. track_state_pass:=true;
  1146. {Force new resultdef pass.}
  1147. condition.resultdef:=nil;
  1148. do_typecheckpass(condition);
  1149. end;
  1150. if not is_constboolnode(condition) then
  1151. aktstate.store_fact(condition,
  1152. cordconstnode.create(byte(checknegate),booltype,true))
  1153. else
  1154. condition.destroy;
  1155. end;
  1156. {$endif}
  1157. {*****************************************************************************
  1158. TIFNODE
  1159. *****************************************************************************}
  1160. constructor tifnode.create(l,r,_t1 : tnode);
  1161. begin
  1162. inherited create(ifn,l,r,_t1,nil);
  1163. end;
  1164. function tifnode.internalsimplify(warn: boolean) : tnode;
  1165. begin
  1166. result:=nil;
  1167. { optimize constant expressions }
  1168. if (left.nodetype=ordconstn) then
  1169. begin
  1170. if tordconstnode(left).value.uvalue=1 then
  1171. begin
  1172. if assigned(right) then
  1173. result:=right
  1174. else
  1175. result:=cnothingnode.create;
  1176. right:=nil;
  1177. if warn and assigned(t1) then
  1178. CGMessagePos(t1.fileinfo,cg_w_unreachable_code);
  1179. end
  1180. else
  1181. begin
  1182. if assigned(t1) then
  1183. result:=t1
  1184. else
  1185. result:=cnothingnode.create;
  1186. t1:=nil;
  1187. if warn and assigned(right) then
  1188. CGMessagePos(right.fileinfo,cg_w_unreachable_code);
  1189. end;
  1190. end;
  1191. end;
  1192. function tifnode.simplify : tnode;
  1193. begin
  1194. result:=internalsimplify(false);
  1195. end;
  1196. function tifnode.pass_typecheck:tnode;
  1197. begin
  1198. result:=nil;
  1199. resultdef:=voidtype;
  1200. typecheckpass(left);
  1201. { tp procvar support }
  1202. maybe_call_procvar(left,true);
  1203. { if path }
  1204. if assigned(right) then
  1205. typecheckpass(right);
  1206. { else path }
  1207. if assigned(t1) then
  1208. typecheckpass(t1);
  1209. set_varstate(left,vs_read,[vsf_must_be_valid]);
  1210. if codegenerror then
  1211. exit;
  1212. if not is_boolean(left.resultdef) then
  1213. begin
  1214. if left.resultdef.typ=variantdef then
  1215. inserttypeconv(left,booltype)
  1216. else
  1217. Message1(type_e_boolean_expr_expected,left.resultdef.typename);
  1218. end;
  1219. result:=internalsimplify(true);
  1220. end;
  1221. function tifnode.pass_1 : tnode;
  1222. begin
  1223. result:=nil;
  1224. expectloc:=LOC_VOID;
  1225. firstpass(left);
  1226. { if path }
  1227. if assigned(right) then
  1228. firstpass(right);
  1229. { else path }
  1230. if assigned(t1) then
  1231. firstpass(t1);
  1232. { leave if we've got an error in one of the paths }
  1233. if codegenerror then
  1234. exit;
  1235. end;
  1236. {*****************************************************************************
  1237. TFORNODE
  1238. *****************************************************************************}
  1239. constructor tfornode.create(l,r,_t1,_t2 : tnode;back : boolean);
  1240. begin
  1241. inherited create(forn,l,r,_t1,_t2);
  1242. if back then
  1243. include(loopflags,lnf_backward);
  1244. include(loopflags,lnf_testatbegin);
  1245. end;
  1246. procedure Tfornode.loop_var_access(not_type:Tnotification_flag;
  1247. symbol:Tsym);
  1248. begin
  1249. {If there is a read access, the value of the loop counter is important;
  1250. at the end of the loop the loop variable should contain the value it
  1251. had in the last iteration.}
  1252. if not_type=vn_onwrite then
  1253. begin
  1254. writeln('Loopvar does not matter on exit');
  1255. end
  1256. else
  1257. begin
  1258. exclude(loopflags,lnf_dont_mind_loopvar_on_exit);
  1259. writeln('Loopvar does matter on exit');
  1260. end;
  1261. Tabstractvarsym(symbol).unregister_notification(loopvar_notid);
  1262. end;
  1263. function tfornode.simplify : tnode;
  1264. begin
  1265. result:=nil;
  1266. if (t1.nodetype=ordconstn) and
  1267. (right.nodetype=ordconstn) and
  1268. (
  1269. (
  1270. (lnf_backward in loopflags) and
  1271. (tordconstnode(right).value<tordconstnode(t1).value)
  1272. ) or
  1273. (
  1274. not(lnf_backward in loopflags) and
  1275. (tordconstnode(right).value>tordconstnode(t1).value)
  1276. )
  1277. ) then
  1278. result:=cnothingnode.create;
  1279. end;
  1280. function tfornode.pass_typecheck:tnode;
  1281. var
  1282. res : tnode;
  1283. begin
  1284. result:=nil;
  1285. resultdef:=voidtype;
  1286. { process the loopvar, from and to, varstates are already set }
  1287. typecheckpass(left);
  1288. typecheckpass(right);
  1289. typecheckpass(t1);
  1290. set_varstate(left,vs_written,[]);
  1291. { loop unrolling }
  1292. if cs_opt_loopunroll in current_settings.optimizerswitches then
  1293. begin
  1294. res:=unroll_loop(self);
  1295. if assigned(res) then
  1296. begin
  1297. typecheckpass(res);
  1298. result:=res;
  1299. exit;
  1300. end;
  1301. end;
  1302. { Can we spare the first comparision? }
  1303. if (t1.nodetype=ordconstn) and
  1304. (right.nodetype=ordconstn) and
  1305. (
  1306. (
  1307. (lnf_backward in loopflags) and
  1308. (Tordconstnode(right).value>=Tordconstnode(t1).value)
  1309. ) or
  1310. (
  1311. not(lnf_backward in loopflags) and
  1312. (Tordconstnode(right).value<=Tordconstnode(t1).value)
  1313. )
  1314. ) then
  1315. exclude(loopflags,lnf_testatbegin);
  1316. { Make sure that the loop var and the
  1317. from and to values are compatible types }
  1318. check_ranges(right.fileinfo,right,left.resultdef);
  1319. inserttypeconv(right,left.resultdef);
  1320. check_ranges(t1.fileinfo,t1,left.resultdef);
  1321. inserttypeconv(t1,left.resultdef);
  1322. if assigned(t2) then
  1323. typecheckpass(t2);
  1324. end;
  1325. function tfornode.pass_1 : tnode;
  1326. begin
  1327. result:=nil;
  1328. expectloc:=LOC_VOID;
  1329. firstpass(left);
  1330. firstpass(right);
  1331. firstpass(t1);
  1332. if assigned(t2) then
  1333. begin
  1334. firstpass(t2);
  1335. if codegenerror then
  1336. exit;
  1337. end;
  1338. end;
  1339. {*****************************************************************************
  1340. TEXITNODE
  1341. *****************************************************************************}
  1342. constructor texitnode.create(l:tnode);
  1343. begin
  1344. inherited create(exitn,l);
  1345. if assigned(left) then
  1346. begin
  1347. { add assignment to funcretsym }
  1348. left:=ctypeconvnode.create(left,current_procinfo.procdef.returndef);
  1349. left:=cassignmentnode.create(
  1350. cloadnode.create(current_procinfo.procdef.funcretsym,current_procinfo.procdef.funcretsym.owner),
  1351. left);
  1352. end;
  1353. end;
  1354. constructor texitnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  1355. begin
  1356. inherited ppuload(t,ppufile);
  1357. end;
  1358. procedure texitnode.ppuwrite(ppufile:tcompilerppufile);
  1359. begin
  1360. inherited ppuwrite(ppufile);
  1361. end;
  1362. function texitnode.pass_typecheck:tnode;
  1363. begin
  1364. result:=nil;
  1365. if assigned(left) then
  1366. typecheckpass(left);
  1367. resultdef:=voidtype;
  1368. end;
  1369. function texitnode.pass_1 : tnode;
  1370. begin
  1371. result:=nil;
  1372. expectloc:=LOC_VOID;
  1373. if assigned(left) then
  1374. begin
  1375. firstpass(left);
  1376. if codegenerror then
  1377. exit;
  1378. end;
  1379. end;
  1380. {*****************************************************************************
  1381. TBREAKNODE
  1382. *****************************************************************************}
  1383. constructor tbreaknode.create;
  1384. begin
  1385. inherited create(breakn);
  1386. end;
  1387. function tbreaknode.pass_typecheck:tnode;
  1388. begin
  1389. result:=nil;
  1390. resultdef:=voidtype;
  1391. end;
  1392. function tbreaknode.pass_1 : tnode;
  1393. begin
  1394. result:=nil;
  1395. expectloc:=LOC_VOID;
  1396. end;
  1397. {*****************************************************************************
  1398. TCONTINUENODE
  1399. *****************************************************************************}
  1400. constructor tcontinuenode.create;
  1401. begin
  1402. inherited create(continuen);
  1403. end;
  1404. function tcontinuenode.pass_typecheck:tnode;
  1405. begin
  1406. result:=nil;
  1407. resultdef:=voidtype;
  1408. end;
  1409. function tcontinuenode.pass_1 : tnode;
  1410. begin
  1411. result:=nil;
  1412. expectloc:=LOC_VOID;
  1413. end;
  1414. {*****************************************************************************
  1415. TGOTONODE
  1416. *****************************************************************************}
  1417. constructor tgotonode.create(p : tlabelsym);
  1418. begin
  1419. inherited create(goton);
  1420. exceptionblock:=current_exceptblock;
  1421. labelnode:=nil;
  1422. labelsym:=p;
  1423. end;
  1424. constructor tgotonode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  1425. begin
  1426. inherited ppuload(t,ppufile);
  1427. labelnodeidx:=ppufile.getlongint;
  1428. exceptionblock:=ppufile.getbyte;
  1429. end;
  1430. procedure tgotonode.ppuwrite(ppufile:tcompilerppufile);
  1431. begin
  1432. inherited ppuwrite(ppufile);
  1433. labelnodeidx:=labelnode.ppuidx;
  1434. ppufile.putlongint(labelnodeidx);
  1435. ppufile.putbyte(exceptionblock);
  1436. end;
  1437. procedure tgotonode.buildderefimpl;
  1438. begin
  1439. inherited buildderefimpl;
  1440. end;
  1441. procedure tgotonode.derefimpl;
  1442. begin
  1443. inherited derefimpl;
  1444. end;
  1445. procedure tgotonode.resolveppuidx;
  1446. begin
  1447. labelnode:=tlabelnode(nodeppuidxget(labelnodeidx));
  1448. if labelnode.nodetype<>labeln then
  1449. internalerror(200809021);
  1450. end;
  1451. function tgotonode.pass_typecheck:tnode;
  1452. begin
  1453. result:=nil;
  1454. resultdef:=voidtype;
  1455. end;
  1456. function tgotonode.pass_1 : tnode;
  1457. begin
  1458. result:=nil;
  1459. expectloc:=LOC_VOID;
  1460. { The labelnode can already be set when
  1461. this node was copied }
  1462. if not(assigned(labelnode)) then
  1463. begin
  1464. { inner procedure goto? }
  1465. if assigned(labelsym.code) and
  1466. ((assigned(labelsym.owner) and (current_procinfo.procdef.parast.symtablelevel=labelsym.owner.symtablelevel)) or
  1467. { generated by the optimizer? }
  1468. not(assigned(labelsym.owner))) then
  1469. labelnode:=tlabelnode(labelsym.code)
  1470. else if (m_iso in current_settings.modeswitches) and
  1471. assigned(labelsym.owner) then
  1472. begin
  1473. if current_procinfo.procdef.parast.symtablelevel>labelsym.owner.symtablelevel then
  1474. begin
  1475. { don't mess with the exception blocks, global gotos in/out side exception blocks are not allowed }
  1476. if exceptionblock>0 then
  1477. CGMessage(cg_e_goto_inout_of_exception_block);
  1478. if assigned(labelsym.jumpbuf) then
  1479. begin
  1480. labelsym.nonlocal:=true;
  1481. result:=ccallnode.createintern('fpc_longjmp',
  1482. ccallparanode.create(cordconstnode.create(1,sinttype,true),
  1483. ccallparanode.create(cloadnode.create(labelsym.jumpbuf,labelsym.jumpbuf.owner),
  1484. nil)));
  1485. end
  1486. else
  1487. CGMessage1(cg_e_goto_label_not_found,labelsym.realname);
  1488. end
  1489. else
  1490. CGMessage(cg_e_interprocedural_goto_only_to_outer_scope_allowed);
  1491. end
  1492. else
  1493. CGMessage1(cg_e_goto_label_not_found,labelsym.realname);
  1494. end;
  1495. { check if we don't mess with exception blocks }
  1496. if assigned(labelnode) and
  1497. (exceptionblock<>labelnode.exceptionblock) then
  1498. CGMessage(cg_e_goto_inout_of_exception_block);
  1499. end;
  1500. function tgotonode.dogetcopy : tnode;
  1501. var
  1502. p : tgotonode;
  1503. begin
  1504. p:=tgotonode(inherited dogetcopy);
  1505. p.exceptionblock:=exceptionblock;
  1506. { generate labelnode if not done yet }
  1507. if not(assigned(labelnode)) then
  1508. begin
  1509. if assigned(labelsym) and assigned(labelsym.code) then
  1510. labelnode:=tlabelnode(labelsym.code)
  1511. end;
  1512. p.labelsym:=labelsym;
  1513. if assigned(labelnode) then
  1514. p.labelnode:=tlabelnode(labelnode.dogetcopy)
  1515. else
  1516. begin
  1517. { don't trigger IE when there was already an error, i.e. the
  1518. label is not defined. See tw11763 (PFV) }
  1519. if errorcount=0 then
  1520. internalerror(200610291);
  1521. end;
  1522. result:=p;
  1523. end;
  1524. function tgotonode.docompare(p: tnode): boolean;
  1525. begin
  1526. docompare := false;
  1527. end;
  1528. {*****************************************************************************
  1529. TLABELNODE
  1530. *****************************************************************************}
  1531. constructor tlabelnode.create(l:tnode;alabsym:tlabelsym);
  1532. begin
  1533. inherited create(labeln,l);
  1534. exceptionblock:=current_exceptblock;
  1535. labsym:=alabsym;
  1536. { Register labelnode in labelsym }
  1537. labsym.code:=self;
  1538. end;
  1539. constructor tlabelnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  1540. begin
  1541. inherited ppuload(t,ppufile);
  1542. exceptionblock:=ppufile.getbyte;
  1543. end;
  1544. destructor tlabelnode.destroy;
  1545. begin
  1546. { Remove reference in labelsym, this is to prevent
  1547. goto's to this label }
  1548. if assigned(labsym) and (labsym.code=pointer(self)) then
  1549. labsym.code:=nil;
  1550. inherited destroy;
  1551. end;
  1552. procedure tlabelnode.ppuwrite(ppufile:tcompilerppufile);
  1553. begin
  1554. inherited ppuwrite(ppufile);
  1555. ppufile.putbyte(exceptionblock);
  1556. end;
  1557. procedure tlabelnode.buildderefimpl;
  1558. begin
  1559. inherited buildderefimpl;
  1560. end;
  1561. procedure tlabelnode.derefimpl;
  1562. begin
  1563. inherited derefimpl;
  1564. end;
  1565. function tlabelnode.pass_typecheck:tnode;
  1566. begin
  1567. result:=nil;
  1568. { left could still be unassigned }
  1569. if assigned(left) then
  1570. typecheckpass(left);
  1571. resultdef:=voidtype;
  1572. end;
  1573. function tlabelnode.pass_1 : tnode;
  1574. begin
  1575. result:=nil;
  1576. expectloc:=LOC_VOID;
  1577. include(current_procinfo.flags,pi_has_label);
  1578. if assigned(left) then
  1579. firstpass(left);
  1580. if (m_iso in current_settings.modeswitches) and
  1581. (current_procinfo.procdef.parast.symtablelevel<>labsym.owner.symtablelevel) then
  1582. CGMessage(cg_e_labels_cannot_defined_outside_declaration_scope)
  1583. end;
  1584. function tlabelnode.dogetcopy : tnode;
  1585. begin
  1586. if not(assigned(copiedto)) then
  1587. copiedto:=tlabelnode(inherited dogetcopy);
  1588. copiedto.exceptionblock:=exceptionblock;
  1589. result:=copiedto;
  1590. end;
  1591. function tlabelnode.docompare(p: tnode): boolean;
  1592. begin
  1593. docompare := false;
  1594. end;
  1595. {*****************************************************************************
  1596. TRAISENODE
  1597. *****************************************************************************}
  1598. constructor traisenode.create(l,taddr,tframe:tnode);
  1599. begin
  1600. inherited create(raisen,l,taddr,tframe);
  1601. end;
  1602. function traisenode.pass_typecheck:tnode;
  1603. begin
  1604. result:=nil;
  1605. resultdef:=voidtype;
  1606. if assigned(left) then
  1607. begin
  1608. { first para must be a _class_ }
  1609. typecheckpass(left);
  1610. set_varstate(left,vs_read,[vsf_must_be_valid]);
  1611. if codegenerror then
  1612. exit;
  1613. if not(is_class(left.resultdef)) then
  1614. CGMessage1(type_e_class_type_expected,left.resultdef.typename);
  1615. { insert needed typeconvs for addr,frame }
  1616. if assigned(right) then
  1617. begin
  1618. { addr }
  1619. typecheckpass(right);
  1620. inserttypeconv(right,voidpointertype);
  1621. { frame }
  1622. if assigned(third) then
  1623. begin
  1624. typecheckpass(third);
  1625. inserttypeconv(third,voidpointertype);
  1626. end;
  1627. end;
  1628. end;
  1629. end;
  1630. function traisenode.pass_1 : tnode;
  1631. begin
  1632. result:=nil;
  1633. include(current_procinfo.flags,pi_do_call);
  1634. expectloc:=LOC_VOID;
  1635. if assigned(left) then
  1636. begin
  1637. { first para must be a _class_ }
  1638. firstpass(left);
  1639. { insert needed typeconvs for addr,frame }
  1640. if assigned(right) then
  1641. begin
  1642. { addr }
  1643. firstpass(right);
  1644. { frame }
  1645. if assigned(third) then
  1646. firstpass(third);
  1647. end;
  1648. end;
  1649. end;
  1650. {*****************************************************************************
  1651. TTRYEXCEPTNODE
  1652. *****************************************************************************}
  1653. constructor ttryexceptnode.create(l,r,_t1 : tnode);
  1654. begin
  1655. inherited create(tryexceptn,l,r,_t1,nil);
  1656. end;
  1657. function ttryexceptnode.pass_typecheck:tnode;
  1658. begin
  1659. result:=nil;
  1660. typecheckpass(left);
  1661. { on statements }
  1662. if assigned(right) then
  1663. typecheckpass(right);
  1664. { else block }
  1665. if assigned(t1) then
  1666. typecheckpass(t1);
  1667. resultdef:=voidtype;
  1668. end;
  1669. function ttryexceptnode.pass_1 : tnode;
  1670. begin
  1671. result:=nil;
  1672. include(current_procinfo.flags,pi_do_call);
  1673. expectloc:=LOC_VOID;
  1674. firstpass(left);
  1675. { on statements }
  1676. if assigned(right) then
  1677. firstpass(right);
  1678. { else block }
  1679. if assigned(t1) then
  1680. firstpass(t1);
  1681. end;
  1682. {*****************************************************************************
  1683. TTRYFINALLYNODE
  1684. *****************************************************************************}
  1685. constructor ttryfinallynode.create(l,r:tnode);
  1686. begin
  1687. inherited create(tryfinallyn,l,r,nil,nil);
  1688. implicitframe:=false;
  1689. end;
  1690. constructor ttryfinallynode.create_implicit(l,r,_t1:tnode);
  1691. begin
  1692. inherited create(tryfinallyn,l,r,_t1,nil);
  1693. implicitframe:=true;
  1694. end;
  1695. function ttryfinallynode.pass_typecheck:tnode;
  1696. begin
  1697. result:=nil;
  1698. include(current_procinfo.flags,pi_do_call);
  1699. resultdef:=voidtype;
  1700. typecheckpass(left);
  1701. // "try block" is "used"? (JM)
  1702. set_varstate(left,vs_readwritten,[vsf_must_be_valid]);
  1703. typecheckpass(right);
  1704. // "except block" is "used"? (JM)
  1705. set_varstate(right,vs_readwritten,[vsf_must_be_valid]);
  1706. { special finally block only executed when there was an exception }
  1707. if assigned(t1) then
  1708. begin
  1709. typecheckpass(t1);
  1710. // "finally block" is "used"? (JM)
  1711. set_varstate(t1,vs_readwritten,[vsf_must_be_valid]);
  1712. end;
  1713. end;
  1714. function ttryfinallynode.pass_1 : tnode;
  1715. begin
  1716. result:=nil;
  1717. expectloc:=LOC_VOID;
  1718. firstpass(left);
  1719. firstpass(right);
  1720. if assigned(t1) then
  1721. firstpass(t1);
  1722. end;
  1723. function ttryfinallynode.simplify: tnode;
  1724. begin
  1725. result:=nil;
  1726. { if the try contains no code, we can kill
  1727. the try and except and return only the
  1728. finally part }
  1729. if has_no_code(left) then
  1730. begin
  1731. result:=right;
  1732. right:=nil;
  1733. end;
  1734. end;
  1735. {*****************************************************************************
  1736. TONNODE
  1737. *****************************************************************************}
  1738. constructor tonnode.create(l,r:tnode);
  1739. begin
  1740. inherited create(onn,l,r);
  1741. excepTSymtable:=nil;
  1742. excepttype:=nil;
  1743. end;
  1744. destructor tonnode.destroy;
  1745. begin
  1746. { copied nodes don't need to release the symtable }
  1747. if assigned(excepTSymtable) then
  1748. excepTSymtable.free;
  1749. inherited destroy;
  1750. end;
  1751. constructor tonnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  1752. begin
  1753. inherited ppuload(t,ppufile);
  1754. excepTSymtable:=nil;
  1755. excepttype:=nil;
  1756. end;
  1757. function tonnode.dogetcopy : tnode;
  1758. var
  1759. n : tonnode;
  1760. begin
  1761. n:=tonnode(inherited dogetcopy);
  1762. if assigned(exceptsymtable) then
  1763. n.exceptsymtable:=exceptsymtable.getcopy
  1764. else
  1765. n.exceptsymtable:=nil;
  1766. n.excepttype:=excepttype;
  1767. result:=n;
  1768. end;
  1769. function tonnode.pass_typecheck:tnode;
  1770. begin
  1771. result:=nil;
  1772. resultdef:=voidtype;
  1773. if not(is_class(excepttype)) then
  1774. CGMessage1(type_e_class_type_expected,excepttype.typename);
  1775. if assigned(left) then
  1776. typecheckpass(left);
  1777. if assigned(right) then
  1778. typecheckpass(right);
  1779. end;
  1780. function tonnode.pass_1 : tnode;
  1781. begin
  1782. result:=nil;
  1783. include(current_procinfo.flags,pi_do_call);
  1784. expectloc:=LOC_VOID;
  1785. if assigned(left) then
  1786. firstpass(left);
  1787. if assigned(right) then
  1788. firstpass(right);
  1789. end;
  1790. function tonnode.docompare(p: tnode): boolean;
  1791. begin
  1792. docompare := false;
  1793. end;
  1794. begin
  1795. cwhilerepeatnode:=twhilerepeatnode;
  1796. cifnode:=tifnode;
  1797. cfornode:=tfornode;
  1798. cexitnode:=texitnode;
  1799. cgotonode:=tgotonode;
  1800. clabelnode:=tlabelnode;
  1801. craisenode:=traisenode;
  1802. ctryexceptnode:=ttryexceptnode;
  1803. ctryfinallynode:=ttryfinallynode;
  1804. connode:=tonnode;
  1805. end.