nflw.pas 54 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810
  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_string_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  222. var
  223. loopstatement, loopbodystatement: tstatementnode;
  224. loopvar, stringvar: ttempcreatenode;
  225. stringindex, loopbody, forloopnode: tnode;
  226. begin
  227. { result is a block of statements }
  228. result:=internalstatements(loopstatement);
  229. { create a temp variable for expression }
  230. stringvar := ctempcreatenode.create(
  231. expr.resultdef,
  232. expr.resultdef.size,
  233. tt_persistent,true);
  234. addstatement(loopstatement,stringvar);
  235. addstatement(loopstatement,cassignmentnode.create(ctemprefnode.create(stringvar),expr.getcopy));
  236. { create a loop counter: signed integer with size of string length }
  237. loopvar := ctempcreatenode.create(
  238. sinttype,
  239. sinttype.size,
  240. tt_persistent,true);
  241. addstatement(loopstatement,loopvar);
  242. stringindex:=ctemprefnode.create(loopvar);
  243. loopbody:=internalstatements(loopbodystatement);
  244. // for-in loop variable := string_expression[index]
  245. addstatement(loopbodystatement,
  246. cassignmentnode.create(hloopvar, cvecnode.create(ctemprefnode.create(stringvar),stringindex)));
  247. { add the actual statement to the loop }
  248. addstatement(loopbodystatement,hloopbody);
  249. forloopnode:=cfornode.create(ctemprefnode.create(loopvar),
  250. genintconstnode(1),
  251. cinlinenode.create(in_length_x,false,ctemprefnode.create(stringvar)),
  252. loopbody,
  253. false);
  254. addstatement(loopstatement,forloopnode);
  255. { free the loop counter }
  256. addstatement(loopstatement,ctempdeletenode.create(loopvar));
  257. { free the temp variable for expression }
  258. addstatement(loopstatement,ctempdeletenode.create(stringvar));
  259. end;
  260. function create_array_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  261. var
  262. loopstatement, loopbodystatement: tstatementnode;
  263. loopvar, arrayvar: ttempcreatenode;
  264. arrayindex, lowbound, highbound, loopbody, forloopnode: tnode;
  265. is_string: boolean;
  266. begin
  267. { result is a block of statements }
  268. result:=internalstatements(loopstatement);
  269. is_string := ado_IsConstString in tarraydef(expr.resultdef).arrayoptions;
  270. if (node_complexity(expr) > 1) and not is_open_array(expr.resultdef) then
  271. begin
  272. { create a temp variable for expression }
  273. arrayvar := ctempcreatenode.create(
  274. expr.resultdef,
  275. expr.resultdef.size,
  276. tt_persistent,true);
  277. if is_string then
  278. begin
  279. lowbound:=genintconstnode(1);
  280. highbound:=cinlinenode.create(in_length_x,false,ctemprefnode.create(arrayvar))
  281. end
  282. else
  283. begin
  284. lowbound:=cinlinenode.create(in_low_x,false,ctemprefnode.create(arrayvar));
  285. highbound:=cinlinenode.create(in_high_x,false,ctemprefnode.create(arrayvar));
  286. end;
  287. addstatement(loopstatement,arrayvar);
  288. addstatement(loopstatement,cassignmentnode.create(ctemprefnode.create(arrayvar),expr.getcopy));
  289. end
  290. else
  291. begin
  292. arrayvar:=nil;
  293. if is_string then
  294. begin
  295. lowbound:=genintconstnode(1);
  296. highbound:=cinlinenode.create(in_length_x,false,expr.getcopy);
  297. end
  298. else
  299. begin
  300. lowbound:=cinlinenode.create(in_low_x,false,expr.getcopy);
  301. highbound:=cinlinenode.create(in_high_x,false,expr.getcopy);
  302. end;
  303. end;
  304. { create a loop counter }
  305. loopvar := ctempcreatenode.create(
  306. tarraydef(expr.resultdef).rangedef,
  307. tarraydef(expr.resultdef).rangedef.size,
  308. tt_persistent,true);
  309. addstatement(loopstatement,loopvar);
  310. arrayindex:=ctemprefnode.create(loopvar);
  311. loopbody:=internalstatements(loopbodystatement);
  312. // for-in loop variable := array_expression[index]
  313. if assigned(arrayvar) then
  314. addstatement(loopbodystatement,
  315. cassignmentnode.create(hloopvar,cvecnode.create(ctemprefnode.create(arrayvar),arrayindex)))
  316. else
  317. addstatement(loopbodystatement,
  318. cassignmentnode.create(hloopvar,cvecnode.create(expr.getcopy,arrayindex)));
  319. { add the actual statement to the loop }
  320. addstatement(loopbodystatement,hloopbody);
  321. forloopnode:=cfornode.create(ctemprefnode.create(loopvar),
  322. lowbound,
  323. highbound,
  324. loopbody,
  325. false);
  326. addstatement(loopstatement,forloopnode);
  327. { free the loop counter }
  328. addstatement(loopstatement,ctempdeletenode.create(loopvar));
  329. { free the temp variable for expression if needed }
  330. if arrayvar<>nil then
  331. addstatement(loopstatement,ctempdeletenode.create(arrayvar));
  332. end;
  333. function create_set_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  334. var
  335. loopstatement, loopbodystatement: tstatementnode;
  336. loopvar, setvar: ttempcreatenode;
  337. loopbody, forloopnode: tnode;
  338. begin
  339. // first check is set is empty and if it so then skip other processing
  340. if not Assigned(tsetdef(expr.resultdef).elementdef) then
  341. begin
  342. result:=cnothingnode.create;
  343. // free unused nodes
  344. hloopvar.free;
  345. hloopbody.free;
  346. exit;
  347. end;
  348. { result is a block of statements }
  349. result:=internalstatements(loopstatement);
  350. { create a temp variable for expression }
  351. setvar := ctempcreatenode.create(
  352. expr.resultdef,
  353. expr.resultdef.size,
  354. tt_persistent,true);
  355. addstatement(loopstatement,setvar);
  356. addstatement(loopstatement,cassignmentnode.create(ctemprefnode.create(setvar),expr.getcopy));
  357. { create a loop counter }
  358. loopvar := ctempcreatenode.create(
  359. tsetdef(expr.resultdef).elementdef,
  360. tsetdef(expr.resultdef).elementdef.size,
  361. tt_persistent,true);
  362. addstatement(loopstatement,loopvar);
  363. // if loopvar in set then
  364. // begin
  365. // hloopvar := loopvar
  366. // for-in loop body
  367. // end
  368. loopbody:=cifnode.create(
  369. cinnode.create(ctemprefnode.create(loopvar),ctemprefnode.create(setvar)),
  370. internalstatements(loopbodystatement),
  371. nil
  372. );
  373. addstatement(loopbodystatement,cassignmentnode.create(hloopvar,ctemprefnode.create(loopvar)));
  374. { add the actual statement to the loop }
  375. addstatement(loopbodystatement,hloopbody);
  376. forloopnode:=cfornode.create(ctemprefnode.create(loopvar),
  377. cinlinenode.create(in_low_x,false,ctemprefnode.create(setvar)),
  378. cinlinenode.create(in_high_x,false,ctemprefnode.create(setvar)),
  379. loopbody,
  380. false);
  381. addstatement(loopstatement,forloopnode);
  382. { free the loop counter }
  383. addstatement(loopstatement,ctempdeletenode.create(loopvar));
  384. { free the temp variable for expression }
  385. addstatement(loopstatement,ctempdeletenode.create(setvar));
  386. end;
  387. function create_enumerator_for_in_loop(hloopvar, hloopbody, expr: tnode;
  388. enumerator_get, enumerator_move: tprocdef; enumerator_current: tpropertysym): tnode;
  389. var
  390. loopstatement, loopbodystatement: tstatementnode;
  391. enumvar: ttempcreatenode;
  392. loopbody, whileloopnode,
  393. enum_get, enum_move, enum_current, enum_get_params: tnode;
  394. propaccesslist: tpropaccesslist;
  395. enumerator_is_class: boolean;
  396. enumerator_destructor: tprocdef;
  397. begin
  398. { result is a block of statements }
  399. result:=internalstatements(loopstatement);
  400. enumerator_is_class := is_class(enumerator_get.returndef);
  401. { create a temp variable for enumerator }
  402. enumvar := ctempcreatenode.create(
  403. enumerator_get.returndef,
  404. enumerator_get.returndef.size,
  405. tt_persistent,true);
  406. addstatement(loopstatement,enumvar);
  407. if enumerator_get.proctypeoption=potype_operator then
  408. begin
  409. enum_get_params:=ccallparanode.create(expr.getcopy,nil);
  410. enum_get:=ccallnode.create(enum_get_params, tprocsym(enumerator_get.procsym), nil, nil, []);
  411. tcallnode(enum_get).procdefinition:=enumerator_get;
  412. addsymref(enumerator_get.procsym);
  413. end
  414. else
  415. enum_get:=ccallnode.create(nil, tprocsym(enumerator_get.procsym), enumerator_get.owner, expr.getcopy, []);
  416. addstatement(loopstatement,
  417. cassignmentnode.create(
  418. ctemprefnode.create(enumvar),
  419. enum_get
  420. ));
  421. loopbody:=internalstatements(loopbodystatement);
  422. { for-in loop variable := enumerator.current }
  423. if getpropaccesslist(enumerator_current,palt_read,propaccesslist) then
  424. begin
  425. case propaccesslist.firstsym^.sym.typ of
  426. fieldvarsym :
  427. begin
  428. { generate access code }
  429. enum_current:=ctemprefnode.create(enumvar);
  430. propaccesslist_to_node(enum_current,enumerator_current.owner,propaccesslist);
  431. include(enum_current.flags,nf_isproperty);
  432. end;
  433. procsym :
  434. begin
  435. { generate the method call }
  436. enum_current:=ccallnode.create(nil,tprocsym(propaccesslist.firstsym^.sym),enumerator_current.owner,ctemprefnode.create(enumvar),[]);
  437. include(enum_current.flags,nf_isproperty);
  438. end
  439. else
  440. begin
  441. enum_current:=cerrornode.create;
  442. Message(type_e_mismatch);
  443. end;
  444. end;
  445. end
  446. else
  447. enum_current:=cerrornode.create;
  448. addstatement(loopbodystatement,
  449. cassignmentnode.create(hloopvar, enum_current));
  450. { add the actual statement to the loop }
  451. addstatement(loopbodystatement,hloopbody);
  452. enum_move:=ccallnode.create(nil, tprocsym(enumerator_move.procsym), enumerator_move.owner, ctemprefnode.create(enumvar), []);
  453. whileloopnode:=cwhilerepeatnode.create(enum_move,loopbody,true,false);
  454. if enumerator_is_class then
  455. begin
  456. { insert a try-finally and call the destructor for the enumerator in the finally section }
  457. enumerator_destructor:=tobjectdef(enumerator_get.returndef).Finddestructor;
  458. if assigned(enumerator_destructor) then
  459. begin
  460. whileloopnode:=ctryfinallynode.create(
  461. whileloopnode, // try node
  462. ccallnode.create(nil,tprocsym(enumerator_destructor.procsym), // finally node
  463. enumerator_destructor.procsym.owner,ctemprefnode.create(enumvar),[]));
  464. end;
  465. { if getenumerator <> nil then do the loop }
  466. whileloopnode:=cifnode.create(
  467. caddnode.create(unequaln, ctemprefnode.create(enumvar), cnilnode.create),
  468. whileloopnode,
  469. nil
  470. );
  471. end;
  472. addstatement(loopstatement, whileloopnode);
  473. if is_object(enumerator_get.returndef) then
  474. begin
  475. // call the object destructor too
  476. enumerator_destructor:=tobjectdef(enumerator_get.returndef).Finddestructor;
  477. if assigned(enumerator_destructor) then
  478. begin
  479. addstatement(loopstatement,
  480. ccallnode.create(nil,tprocsym(enumerator_destructor.procsym),
  481. enumerator_destructor.procsym.owner,ctemprefnode.create(enumvar),[]));
  482. end;
  483. end;
  484. { free the temp variable for enumerator }
  485. addstatement(loopstatement,ctempdeletenode.create(enumvar));
  486. end;
  487. function create_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
  488. var
  489. pd, movenext: tprocdef;
  490. current: tpropertysym;
  491. storefilepos: tfileposinfo;
  492. begin
  493. storefilepos:=current_filepos;
  494. current_filepos:=hloopvar.fileinfo;
  495. if expr.nodetype=typen then
  496. begin
  497. if (expr.resultdef.typ=enumdef) and tenumdef(expr.resultdef).has_jumps then
  498. begin
  499. result:=cerrornode.create;
  500. hloopvar.free;
  501. hloopbody.free;
  502. MessagePos1(expr.fileinfo,parser_e_for_in_loop_cannot_be_used_for_the_type,expr.resultdef.typename);
  503. end
  504. else
  505. result:=create_type_for_in_loop(hloopvar, hloopbody, expr);
  506. end
  507. else
  508. begin
  509. { loop is made for an expression }
  510. // search for operator first
  511. pd:=search_enumerator_operator(expr.resultdef);
  512. // if there is no operator then search for class/object enumerator method
  513. if (pd=nil) and (expr.resultdef.typ=objectdef) then
  514. pd:=tobjectdef(expr.resultdef).search_enumerator_get;
  515. if pd<>nil then
  516. begin
  517. // seach movenext and current symbols
  518. movenext:=tobjectdef(pd.returndef).search_enumerator_move;
  519. if movenext = nil then
  520. begin
  521. result:=cerrornode.create;
  522. hloopvar.free;
  523. hloopbody.free;
  524. MessagePos1(expr.fileinfo,sym_e_no_enumerator_move,pd.returndef.GetTypeName);
  525. end
  526. else
  527. begin
  528. current:=tpropertysym(tobjectdef(pd.returndef).search_enumerator_current);
  529. if current = nil then
  530. begin
  531. result:=cerrornode.create;
  532. hloopvar.free;
  533. hloopbody.free;
  534. MessagePos1(expr.fileinfo,sym_e_no_enumerator_current,pd.returndef.GetTypeName);
  535. end
  536. else
  537. result:=create_enumerator_for_in_loop(hloopvar, hloopbody, expr, pd, movenext, current);
  538. end;
  539. end
  540. else
  541. begin
  542. case expr.resultdef.typ of
  543. stringdef: result:=create_string_for_in_loop(hloopvar, hloopbody, expr);
  544. arraydef: result:=create_array_for_in_loop(hloopvar, hloopbody, expr);
  545. setdef: result:=create_set_for_in_loop(hloopvar, hloopbody, expr);
  546. else
  547. begin
  548. result:=cerrornode.create;
  549. hloopvar.free;
  550. hloopbody.free;
  551. MessagePos1(expr.fileinfo,sym_e_no_enumerator,expr.resultdef.GetTypeName);
  552. end;
  553. end;
  554. end;
  555. end;
  556. current_filepos:=storefilepos;
  557. end;
  558. {****************************************************************************
  559. TLOOPNODE
  560. *****************************************************************************}
  561. constructor tloopnode.create(tt : tnodetype;l,r,_t1,_t2 : tnode);
  562. begin
  563. inherited create(tt,l,r);
  564. t1:=_t1;
  565. t2:=_t2;
  566. fileinfo:=l.fileinfo;
  567. end;
  568. destructor tloopnode.destroy;
  569. begin
  570. t1.free;
  571. t2.free;
  572. inherited destroy;
  573. end;
  574. constructor tloopnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  575. begin
  576. inherited ppuload(t,ppufile);
  577. t1:=ppuloadnode(ppufile);
  578. t2:=ppuloadnode(ppufile);
  579. end;
  580. procedure tloopnode.ppuwrite(ppufile:tcompilerppufile);
  581. begin
  582. inherited ppuwrite(ppufile);
  583. ppuwritenode(ppufile,t1);
  584. ppuwritenode(ppufile,t2);
  585. end;
  586. procedure tloopnode.buildderefimpl;
  587. begin
  588. inherited buildderefimpl;
  589. if assigned(t1) then
  590. t1.buildderefimpl;
  591. if assigned(t2) then
  592. t2.buildderefimpl;
  593. end;
  594. procedure tloopnode.derefimpl;
  595. begin
  596. inherited derefimpl;
  597. if assigned(t1) then
  598. t1.derefimpl;
  599. if assigned(t2) then
  600. t2.derefimpl;
  601. end;
  602. function tloopnode.dogetcopy : tnode;
  603. var
  604. p : tloopnode;
  605. begin
  606. p:=tloopnode(inherited dogetcopy);
  607. if assigned(t1) then
  608. p.t1:=t1.dogetcopy
  609. else
  610. p.t1:=nil;
  611. if assigned(t2) then
  612. p.t2:=t2.dogetcopy
  613. else
  614. p.t2:=nil;
  615. p.loopflags:=loopflags;
  616. dogetcopy:=p;
  617. end;
  618. procedure tloopnode.insertintolist(l : tnodelist);
  619. begin
  620. end;
  621. procedure tloopnode.printnodetree(var t:text);
  622. begin
  623. write(t,printnodeindention,'(');
  624. printnodeindent;
  625. printnodeinfo(t);
  626. writeln(t);
  627. printnode(t,left);
  628. printnode(t,right);
  629. printnode(t,t1);
  630. printnode(t,t2);
  631. printnodeunindent;
  632. writeln(t,printnodeindention,')');
  633. end;
  634. function tloopnode.docompare(p: tnode): boolean;
  635. begin
  636. docompare :=
  637. inherited docompare(p) and
  638. (loopflags*loopflagsequal=tloopnode(p).loopflags*loopflagsequal) and
  639. t1.isequal(tloopnode(p).t1) and
  640. t2.isequal(tloopnode(p).t2);
  641. end;
  642. {****************************************************************************
  643. TWHILEREPEATNODE
  644. *****************************************************************************}
  645. constructor Twhilerepeatnode.create(l,r:Tnode;tab,cn:boolean);
  646. begin
  647. inherited create(whilerepeatn,l,r,nil,nil);
  648. if tab then
  649. include(loopflags, lnf_testatbegin);
  650. if cn then
  651. include(loopflags,lnf_checknegate);
  652. end;
  653. function twhilerepeatnode.pass_typecheck:tnode;
  654. var
  655. t:Tunarynode;
  656. begin
  657. result:=nil;
  658. resultdef:=voidtype;
  659. typecheckpass(left);
  660. { tp procvar support }
  661. maybe_call_procvar(left,true);
  662. {A not node can be removed.}
  663. if left.nodetype=notn then
  664. begin
  665. t:=Tunarynode(left);
  666. left:=Tunarynode(left).left;
  667. t.left:=nil;
  668. t.destroy;
  669. {Symdif operator, in case you are wondering:}
  670. loopflags:=loopflags >< [lnf_checknegate];
  671. end;
  672. { loop instruction }
  673. if assigned(right) then
  674. typecheckpass(right);
  675. set_varstate(left,vs_read,[vsf_must_be_valid]);
  676. if codegenerror then
  677. exit;
  678. if not is_boolean(left.resultdef) then
  679. begin
  680. if left.resultdef.typ=variantdef then
  681. inserttypeconv(left,booltype)
  682. else
  683. CGMessage1(type_e_boolean_expr_expected,left.resultdef.typename);
  684. end;
  685. { Give warnings for code that will never be executed for
  686. while false do }
  687. if (lnf_testatbegin in loopflags) and
  688. (left.nodetype=ordconstn) and
  689. (tordconstnode(left).value.uvalue=0) and
  690. assigned(right) then
  691. CGMessagePos(right.fileinfo,cg_w_unreachable_code);
  692. end;
  693. {$ifdef prefetchnext}
  694. type
  695. passignmentquery = ^tassignmentquery;
  696. tassignmentquery = record
  697. towhat: tnode;
  698. source: tassignmentnode;
  699. statementcount: cardinal;
  700. end;
  701. function checkassignment(var n: tnode; arg: pointer): foreachnoderesult;
  702. var
  703. query: passignmentquery absolute arg;
  704. temp, prederef: tnode;
  705. begin
  706. result := fen_norecurse_false;
  707. if (n.nodetype in [assignn,inlinen,forn,calln,whilerepeatn,casen,ifn]) then
  708. inc(query^.statementcount);
  709. { make sure there's something else in the loop besides going to the }
  710. { next item }
  711. if (query^.statementcount > 1) and
  712. (n.nodetype = assignn) then
  713. begin
  714. { skip type conversions of assignment target }
  715. temp := tassignmentnode(n).left;
  716. while (temp.nodetype = typeconvn) do
  717. temp := ttypeconvnode(temp).left;
  718. { assignment to x of the while assigned(x) check? }
  719. if not(temp.isequal(query^.towhat)) then
  720. exit;
  721. { right hand side of assignment dereferenced field of }
  722. { x? (no derefn in case of class) }
  723. temp := tassignmentnode(n).right;
  724. while (temp.nodetype = typeconvn) do
  725. temp := ttypeconvnode(temp).left;
  726. if (temp.nodetype <> subscriptn) then
  727. exit;
  728. prederef := tsubscriptnode(temp).left;
  729. temp := prederef;
  730. while (temp.nodetype = typeconvn) do
  731. temp := ttypeconvnode(temp).left;
  732. { see tests/test/prefetch1.pp }
  733. if (temp.nodetype = derefn) then
  734. temp := tderefnode(temp).left
  735. else
  736. temp := prederef;
  737. if temp.isequal(query^.towhat) then
  738. begin
  739. query^.source := tassignmentnode(n);
  740. result := fen_norecurse_true;
  741. end
  742. end
  743. { don't check nodes which can't contain an assignment or whose }
  744. { final assignment can vary a lot }
  745. else if not(n.nodetype in [calln,inlinen,casen,whilerepeatn,forn]) then
  746. result := fen_false;
  747. end;
  748. function findassignment(where: tnode; towhat: tnode): tassignmentnode;
  749. var
  750. query: tassignmentquery;
  751. begin
  752. query.towhat := towhat;
  753. query.source := nil;
  754. query.statementcount := 0;
  755. if foreachnodestatic(where,@checkassignment,@query) then
  756. result := query.source
  757. else
  758. result := nil;
  759. end;
  760. {$endif prefetchnext}
  761. function twhilerepeatnode.pass_1 : tnode;
  762. {$ifdef prefetchnext}
  763. var
  764. runnernode, prefetchcode: tnode;
  765. assignmentnode: tassignmentnode;
  766. prefetchstatements: tstatementnode;
  767. {$endif prefetchnext}
  768. begin
  769. result:=nil;
  770. expectloc:=LOC_VOID;
  771. firstpass(left);
  772. if codegenerror then
  773. exit;
  774. { loop instruction }
  775. if assigned(right) then
  776. begin
  777. firstpass(right);
  778. if codegenerror then
  779. exit;
  780. end;
  781. {$ifdef prefetchnext}
  782. { do at the end so all complex typeconversions are already }
  783. { converted to calln's }
  784. if (cs_opt_level1 in current_settings.optimizerswitches) and
  785. (lnf_testatbegin in loopflags) then
  786. begin
  787. { get first component of the while check }
  788. runnernode := left;
  789. while (runnernode.nodetype in [andn,orn,notn,xorn,typeconvn]) do
  790. runnernode := tunarynode(runnernode).left;
  791. { is it an assigned(x) check? }
  792. if ((runnernode.nodetype = inlinen) and
  793. (tinlinenode(runnernode).inlinenumber = in_assigned_x)) or
  794. ((runnernode.nodetype = unequaln) and
  795. (taddnode(runnernode).right.nodetype = niln)) then
  796. begin
  797. runnernode := tunarynode(runnernode).left;
  798. { in case of in_assigned_x, there's a callparan in between }
  799. if (runnernode.nodetype = callparan) then
  800. runnernode := tcallparanode(runnernode).left;
  801. while (runnernode.nodetype = typeconvn) do
  802. runnernode := ttypeconvnode(runnernode).left;
  803. { is there an "x := x(^).somefield"? }
  804. assignmentnode := findassignment(right,runnernode);
  805. if assigned(assignmentnode) then
  806. begin
  807. prefetchcode := internalstatements(prefetchstatements);
  808. addstatement(prefetchstatements,geninlinenode(in_prefetch_var,false,
  809. cderefnode.create(ctypeconvnode.create(assignmentnode.right.getcopy,voidpointertype))));
  810. addstatement(prefetchstatements,right);
  811. right := prefetchcode;
  812. typecheckpass(right);
  813. end;
  814. end;
  815. end;
  816. {$endif prefetchnext}
  817. end;
  818. {$ifdef state_tracking}
  819. function Twhilerepeatnode.track_state_pass(exec_known:boolean):boolean;
  820. var condition:Tnode;
  821. code:Tnode;
  822. done:boolean;
  823. value:boolean;
  824. change:boolean;
  825. firsttest:boolean;
  826. factval:Tnode;
  827. begin
  828. track_state_pass:=false;
  829. done:=false;
  830. firsttest:=true;
  831. {For repeat until statements, first do a pass through the code.}
  832. if not(lnf_testatbegin in flags) then
  833. begin
  834. code:=right.getcopy;
  835. if code.track_state_pass(exec_known) then
  836. track_state_pass:=true;
  837. code.destroy;
  838. end;
  839. repeat
  840. condition:=left.getcopy;
  841. code:=right.getcopy;
  842. change:=condition.track_state_pass(exec_known);
  843. factval:=aktstate.find_fact(left);
  844. if factval<>nil then
  845. begin
  846. condition.destroy;
  847. condition:=factval.getcopy;
  848. change:=true;
  849. end;
  850. if change then
  851. begin
  852. track_state_pass:=true;
  853. {Force new resultdef pass.}
  854. condition.resultdef:=nil;
  855. do_typecheckpass(condition);
  856. end;
  857. if is_constboolnode(condition) then
  858. begin
  859. {Try to turn a while loop into a repeat loop.}
  860. if firsttest then
  861. exclude(flags,testatbegin);
  862. value:=(Tordconstnode(condition).value<>0) xor checknegate;
  863. if value then
  864. begin
  865. if code.track_state_pass(exec_known) then
  866. track_state_pass:=true;
  867. end
  868. else
  869. done:=true;
  870. end
  871. else
  872. begin
  873. {Remove any modified variables from the state.}
  874. code.track_state_pass(false);
  875. done:=true;
  876. end;
  877. code.destroy;
  878. condition.destroy;
  879. firsttest:=false;
  880. until done;
  881. {The loop condition is also known, for example:
  882. while i<10 do
  883. begin
  884. ...
  885. end;
  886. When the loop is done, we do know that i<10 = false.
  887. }
  888. condition:=left.getcopy;
  889. if condition.track_state_pass(exec_known) then
  890. begin
  891. track_state_pass:=true;
  892. {Force new resultdef pass.}
  893. condition.resultdef:=nil;
  894. do_typecheckpass(condition);
  895. end;
  896. if not is_constboolnode(condition) then
  897. aktstate.store_fact(condition,
  898. cordconstnode.create(byte(checknegate),booltype,true))
  899. else
  900. condition.destroy;
  901. end;
  902. {$endif}
  903. {*****************************************************************************
  904. TIFNODE
  905. *****************************************************************************}
  906. constructor tifnode.create(l,r,_t1 : tnode);
  907. begin
  908. inherited create(ifn,l,r,_t1,nil);
  909. end;
  910. function tifnode.internalsimplify(warn: boolean) : tnode;
  911. begin
  912. result:=nil;
  913. { optimize constant expressions }
  914. if (left.nodetype=ordconstn) then
  915. begin
  916. if tordconstnode(left).value.uvalue=1 then
  917. begin
  918. if assigned(right) then
  919. result:=right
  920. else
  921. result:=cnothingnode.create;
  922. right:=nil;
  923. if warn and assigned(t1) then
  924. CGMessagePos(t1.fileinfo,cg_w_unreachable_code);
  925. end
  926. else
  927. begin
  928. if assigned(t1) then
  929. result:=t1
  930. else
  931. result:=cnothingnode.create;
  932. t1:=nil;
  933. if warn and assigned(right) then
  934. CGMessagePos(right.fileinfo,cg_w_unreachable_code);
  935. end;
  936. end;
  937. end;
  938. function tifnode.simplify : tnode;
  939. begin
  940. result:=internalsimplify(false);
  941. end;
  942. function tifnode.pass_typecheck:tnode;
  943. begin
  944. result:=nil;
  945. resultdef:=voidtype;
  946. typecheckpass(left);
  947. { tp procvar support }
  948. maybe_call_procvar(left,true);
  949. { if path }
  950. if assigned(right) then
  951. typecheckpass(right);
  952. { else path }
  953. if assigned(t1) then
  954. typecheckpass(t1);
  955. set_varstate(left,vs_read,[vsf_must_be_valid]);
  956. if codegenerror then
  957. exit;
  958. if not is_boolean(left.resultdef) then
  959. begin
  960. if left.resultdef.typ=variantdef then
  961. inserttypeconv(left,booltype)
  962. else
  963. Message1(type_e_boolean_expr_expected,left.resultdef.typename);
  964. end;
  965. result:=internalsimplify(true);
  966. end;
  967. function tifnode.pass_1 : tnode;
  968. begin
  969. result:=nil;
  970. expectloc:=LOC_VOID;
  971. firstpass(left);
  972. { if path }
  973. if assigned(right) then
  974. firstpass(right);
  975. { else path }
  976. if assigned(t1) then
  977. firstpass(t1);
  978. { leave if we've got an error in one of the paths }
  979. if codegenerror then
  980. exit;
  981. end;
  982. {*****************************************************************************
  983. TFORNODE
  984. *****************************************************************************}
  985. constructor tfornode.create(l,r,_t1,_t2 : tnode;back : boolean);
  986. begin
  987. inherited create(forn,l,r,_t1,_t2);
  988. if back then
  989. include(loopflags,lnf_backward);
  990. include(loopflags,lnf_testatbegin);
  991. end;
  992. procedure Tfornode.loop_var_access(not_type:Tnotification_flag;
  993. symbol:Tsym);
  994. begin
  995. {If there is a read access, the value of the loop counter is important;
  996. at the end of the loop the loop variable should contain the value it
  997. had in the last iteration.}
  998. if not_type=vn_onwrite then
  999. begin
  1000. writeln('Loopvar does not matter on exit');
  1001. end
  1002. else
  1003. begin
  1004. exclude(loopflags,lnf_dont_mind_loopvar_on_exit);
  1005. writeln('Loopvar does matter on exit');
  1006. end;
  1007. Tabstractvarsym(symbol).unregister_notification(loopvar_notid);
  1008. end;
  1009. function tfornode.simplify : tnode;
  1010. begin
  1011. result:=nil;
  1012. if (t1.nodetype=ordconstn) and
  1013. (right.nodetype=ordconstn) and
  1014. (
  1015. (
  1016. (lnf_backward in loopflags) and
  1017. (tordconstnode(right).value<tordconstnode(t1).value)
  1018. ) or
  1019. (
  1020. not(lnf_backward in loopflags) and
  1021. (tordconstnode(right).value>tordconstnode(t1).value)
  1022. )
  1023. ) then
  1024. result:=cnothingnode.create;
  1025. end;
  1026. function tfornode.pass_typecheck:tnode;
  1027. var
  1028. res : tnode;
  1029. begin
  1030. result:=nil;
  1031. resultdef:=voidtype;
  1032. { process the loopvar, from and to, varstates are already set }
  1033. typecheckpass(left);
  1034. typecheckpass(right);
  1035. typecheckpass(t1);
  1036. set_varstate(left,vs_written,[]);
  1037. { loop unrolling }
  1038. if cs_opt_loopunroll in current_settings.optimizerswitches then
  1039. begin
  1040. res:=unroll_loop(self);
  1041. if assigned(res) then
  1042. begin
  1043. typecheckpass(res);
  1044. result:=res;
  1045. exit;
  1046. end;
  1047. end;
  1048. { Can we spare the first comparision? }
  1049. if (t1.nodetype=ordconstn) and
  1050. (right.nodetype=ordconstn) and
  1051. (
  1052. (
  1053. (lnf_backward in loopflags) and
  1054. (Tordconstnode(right).value>=Tordconstnode(t1).value)
  1055. ) or
  1056. (
  1057. not(lnf_backward in loopflags) and
  1058. (Tordconstnode(right).value<=Tordconstnode(t1).value)
  1059. )
  1060. ) then
  1061. exclude(loopflags,lnf_testatbegin);
  1062. { Make sure that the loop var and the
  1063. from and to values are compatible types }
  1064. check_ranges(right.fileinfo,right,left.resultdef);
  1065. inserttypeconv(right,left.resultdef);
  1066. check_ranges(t1.fileinfo,t1,left.resultdef);
  1067. inserttypeconv(t1,left.resultdef);
  1068. if assigned(t2) then
  1069. typecheckpass(t2);
  1070. end;
  1071. function tfornode.pass_1 : tnode;
  1072. begin
  1073. result:=nil;
  1074. expectloc:=LOC_VOID;
  1075. firstpass(left);
  1076. firstpass(right);
  1077. firstpass(t1);
  1078. if assigned(t2) then
  1079. begin
  1080. firstpass(t2);
  1081. if codegenerror then
  1082. exit;
  1083. end;
  1084. end;
  1085. {*****************************************************************************
  1086. TEXITNODE
  1087. *****************************************************************************}
  1088. constructor texitnode.create(l:tnode);
  1089. begin
  1090. inherited create(exitn,l);
  1091. end;
  1092. constructor texitnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  1093. begin
  1094. inherited ppuload(t,ppufile);
  1095. end;
  1096. procedure texitnode.ppuwrite(ppufile:tcompilerppufile);
  1097. begin
  1098. inherited ppuwrite(ppufile);
  1099. end;
  1100. function texitnode.pass_typecheck:tnode;
  1101. begin
  1102. result:=nil;
  1103. if assigned(left) then
  1104. begin
  1105. { add assignment to funcretsym }
  1106. inserttypeconv(left,current_procinfo.procdef.returndef);
  1107. left:=cassignmentnode.create(
  1108. cloadnode.create(current_procinfo.procdef.funcretsym,current_procinfo.procdef.funcretsym.owner),
  1109. left);
  1110. typecheckpass(left);
  1111. set_varstate(left,vs_read,[vsf_must_be_valid]);
  1112. end;
  1113. resultdef:=voidtype;
  1114. end;
  1115. function texitnode.pass_1 : tnode;
  1116. begin
  1117. result:=nil;
  1118. expectloc:=LOC_VOID;
  1119. if assigned(left) then
  1120. begin
  1121. firstpass(left);
  1122. if codegenerror then
  1123. exit;
  1124. end;
  1125. end;
  1126. {*****************************************************************************
  1127. TBREAKNODE
  1128. *****************************************************************************}
  1129. constructor tbreaknode.create;
  1130. begin
  1131. inherited create(breakn);
  1132. end;
  1133. function tbreaknode.pass_typecheck:tnode;
  1134. begin
  1135. result:=nil;
  1136. resultdef:=voidtype;
  1137. end;
  1138. function tbreaknode.pass_1 : tnode;
  1139. begin
  1140. result:=nil;
  1141. expectloc:=LOC_VOID;
  1142. end;
  1143. {*****************************************************************************
  1144. TCONTINUENODE
  1145. *****************************************************************************}
  1146. constructor tcontinuenode.create;
  1147. begin
  1148. inherited create(continuen);
  1149. end;
  1150. function tcontinuenode.pass_typecheck:tnode;
  1151. begin
  1152. result:=nil;
  1153. resultdef:=voidtype;
  1154. end;
  1155. function tcontinuenode.pass_1 : tnode;
  1156. begin
  1157. result:=nil;
  1158. expectloc:=LOC_VOID;
  1159. end;
  1160. {*****************************************************************************
  1161. TGOTONODE
  1162. *****************************************************************************}
  1163. constructor tgotonode.create(p : tlabelsym);
  1164. begin
  1165. inherited create(goton);
  1166. exceptionblock:=current_exceptblock;
  1167. labelnode:=nil;
  1168. labelsym:=p;
  1169. end;
  1170. constructor tgotonode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  1171. begin
  1172. inherited ppuload(t,ppufile);
  1173. labelnodeidx:=ppufile.getlongint;
  1174. exceptionblock:=ppufile.getbyte;
  1175. end;
  1176. procedure tgotonode.ppuwrite(ppufile:tcompilerppufile);
  1177. begin
  1178. inherited ppuwrite(ppufile);
  1179. labelnodeidx:=labelnode.ppuidx;
  1180. ppufile.putlongint(labelnodeidx);
  1181. ppufile.putbyte(exceptionblock);
  1182. end;
  1183. procedure tgotonode.buildderefimpl;
  1184. begin
  1185. inherited buildderefimpl;
  1186. end;
  1187. procedure tgotonode.derefimpl;
  1188. begin
  1189. inherited derefimpl;
  1190. end;
  1191. procedure tgotonode.resolveppuidx;
  1192. begin
  1193. labelnode:=tlabelnode(nodeppuidxget(labelnodeidx));
  1194. if labelnode.nodetype<>labeln then
  1195. internalerror(200809021);
  1196. end;
  1197. function tgotonode.pass_typecheck:tnode;
  1198. begin
  1199. result:=nil;
  1200. resultdef:=voidtype;
  1201. end;
  1202. function tgotonode.pass_1 : tnode;
  1203. begin
  1204. result:=nil;
  1205. expectloc:=LOC_VOID;
  1206. include(current_procinfo.flags,pi_has_goto);
  1207. { The labelnode can already be set when
  1208. this node was copied }
  1209. if not assigned(labelnode) then
  1210. begin
  1211. if assigned(labelsym.code) then
  1212. labelnode:=tlabelnode(labelsym.code)
  1213. else
  1214. CGMessage1(cg_e_goto_label_not_found,labelsym.realname);
  1215. end;
  1216. { check if we don't mess with exception blocks }
  1217. if assigned(labelnode) and
  1218. (exceptionblock<>labelnode.exceptionblock) then
  1219. CGMessage(cg_e_goto_inout_of_exception_block);
  1220. end;
  1221. function tgotonode.dogetcopy : tnode;
  1222. var
  1223. p : tgotonode;
  1224. begin
  1225. p:=tgotonode(inherited dogetcopy);
  1226. p.exceptionblock:=exceptionblock;
  1227. { generate labelnode if not done yet }
  1228. if not(assigned(labelnode)) then
  1229. begin
  1230. if assigned(labelsym) and assigned(labelsym.code) then
  1231. labelnode:=tlabelnode(labelsym.code)
  1232. end;
  1233. p.labelsym:=labelsym;
  1234. if assigned(labelnode) then
  1235. p.labelnode:=tlabelnode(labelnode.dogetcopy)
  1236. else
  1237. begin
  1238. { don't trigger IE when there was already an error, i.e. the
  1239. label is not defined. See tw11763 (PFV) }
  1240. if errorcount=0 then
  1241. internalerror(200610291);
  1242. end;
  1243. result:=p;
  1244. end;
  1245. function tgotonode.docompare(p: tnode): boolean;
  1246. begin
  1247. docompare := false;
  1248. end;
  1249. {*****************************************************************************
  1250. TLABELNODE
  1251. *****************************************************************************}
  1252. constructor tlabelnode.create(l:tnode;alabsym:tlabelsym);
  1253. begin
  1254. inherited create(labeln,l);
  1255. exceptionblock:=current_exceptblock;
  1256. labsym:=alabsym;
  1257. { Register labelnode in labelsym }
  1258. labsym.code:=self;
  1259. end;
  1260. constructor tlabelnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  1261. begin
  1262. inherited ppuload(t,ppufile);
  1263. exceptionblock:=ppufile.getbyte;
  1264. end;
  1265. destructor tlabelnode.destroy;
  1266. begin
  1267. { Remove reference in labelsym, this is to prevent
  1268. goto's to this label }
  1269. if assigned(labsym) and (labsym.code=pointer(self)) then
  1270. labsym.code:=nil;
  1271. inherited destroy;
  1272. end;
  1273. procedure tlabelnode.ppuwrite(ppufile:tcompilerppufile);
  1274. begin
  1275. inherited ppuwrite(ppufile);
  1276. ppufile.putbyte(exceptionblock);
  1277. end;
  1278. procedure tlabelnode.buildderefimpl;
  1279. begin
  1280. inherited buildderefimpl;
  1281. end;
  1282. procedure tlabelnode.derefimpl;
  1283. begin
  1284. inherited derefimpl;
  1285. end;
  1286. function tlabelnode.pass_typecheck:tnode;
  1287. begin
  1288. result:=nil;
  1289. { left could still be unassigned }
  1290. if assigned(left) then
  1291. typecheckpass(left);
  1292. resultdef:=voidtype;
  1293. end;
  1294. function tlabelnode.pass_1 : tnode;
  1295. begin
  1296. result:=nil;
  1297. expectloc:=LOC_VOID;
  1298. if assigned(left) then
  1299. firstpass(left);
  1300. end;
  1301. function tlabelnode.dogetcopy : tnode;
  1302. begin
  1303. if not(assigned(copiedto)) then
  1304. copiedto:=tlabelnode(inherited dogetcopy);
  1305. copiedto.exceptionblock:=exceptionblock;
  1306. result:=copiedto;
  1307. end;
  1308. function tlabelnode.docompare(p: tnode): boolean;
  1309. begin
  1310. docompare := false;
  1311. end;
  1312. {*****************************************************************************
  1313. TRAISENODE
  1314. *****************************************************************************}
  1315. constructor traisenode.create(l,taddr,tframe:tnode);
  1316. begin
  1317. inherited create(raisen,l,taddr,tframe);
  1318. end;
  1319. function traisenode.pass_typecheck:tnode;
  1320. begin
  1321. result:=nil;
  1322. resultdef:=voidtype;
  1323. if assigned(left) then
  1324. begin
  1325. { first para must be a _class_ }
  1326. typecheckpass(left);
  1327. set_varstate(left,vs_read,[vsf_must_be_valid]);
  1328. if codegenerror then
  1329. exit;
  1330. if not(is_class(left.resultdef)) then
  1331. CGMessage1(type_e_class_type_expected,left.resultdef.typename);
  1332. { insert needed typeconvs for addr,frame }
  1333. if assigned(right) then
  1334. begin
  1335. { addr }
  1336. typecheckpass(right);
  1337. inserttypeconv(right,voidpointertype);
  1338. { frame }
  1339. if assigned(third) then
  1340. begin
  1341. typecheckpass(third);
  1342. inserttypeconv(third,voidpointertype);
  1343. end;
  1344. end;
  1345. end;
  1346. end;
  1347. function traisenode.pass_1 : tnode;
  1348. begin
  1349. result:=nil;
  1350. include(current_procinfo.flags,pi_do_call);
  1351. expectloc:=LOC_VOID;
  1352. if assigned(left) then
  1353. begin
  1354. { first para must be a _class_ }
  1355. firstpass(left);
  1356. { insert needed typeconvs for addr,frame }
  1357. if assigned(right) then
  1358. begin
  1359. { addr }
  1360. firstpass(right);
  1361. { frame }
  1362. if assigned(third) then
  1363. firstpass(third);
  1364. end;
  1365. end;
  1366. end;
  1367. {*****************************************************************************
  1368. TTRYEXCEPTNODE
  1369. *****************************************************************************}
  1370. constructor ttryexceptnode.create(l,r,_t1 : tnode);
  1371. begin
  1372. inherited create(tryexceptn,l,r,_t1,nil);
  1373. end;
  1374. function ttryexceptnode.pass_typecheck:tnode;
  1375. begin
  1376. result:=nil;
  1377. typecheckpass(left);
  1378. { on statements }
  1379. if assigned(right) then
  1380. typecheckpass(right);
  1381. { else block }
  1382. if assigned(t1) then
  1383. typecheckpass(t1);
  1384. resultdef:=voidtype;
  1385. end;
  1386. function ttryexceptnode.pass_1 : tnode;
  1387. begin
  1388. result:=nil;
  1389. include(current_procinfo.flags,pi_do_call);
  1390. expectloc:=LOC_VOID;
  1391. firstpass(left);
  1392. { on statements }
  1393. if assigned(right) then
  1394. firstpass(right);
  1395. { else block }
  1396. if assigned(t1) then
  1397. firstpass(t1);
  1398. end;
  1399. {*****************************************************************************
  1400. TTRYFINALLYNODE
  1401. *****************************************************************************}
  1402. constructor ttryfinallynode.create(l,r:tnode);
  1403. begin
  1404. inherited create(tryfinallyn,l,r,nil,nil);
  1405. implicitframe:=false;
  1406. end;
  1407. constructor ttryfinallynode.create_implicit(l,r,_t1:tnode);
  1408. begin
  1409. inherited create(tryfinallyn,l,r,_t1,nil);
  1410. implicitframe:=true;
  1411. end;
  1412. function ttryfinallynode.pass_typecheck:tnode;
  1413. begin
  1414. result:=nil;
  1415. include(current_procinfo.flags,pi_do_call);
  1416. resultdef:=voidtype;
  1417. typecheckpass(left);
  1418. // "try block" is "used"? (JM)
  1419. set_varstate(left,vs_readwritten,[vsf_must_be_valid]);
  1420. typecheckpass(right);
  1421. // "except block" is "used"? (JM)
  1422. set_varstate(right,vs_readwritten,[vsf_must_be_valid]);
  1423. { special finally block only executed when there was an exception }
  1424. if assigned(t1) then
  1425. begin
  1426. typecheckpass(t1);
  1427. // "finally block" is "used"? (JM)
  1428. set_varstate(t1,vs_readwritten,[vsf_must_be_valid]);
  1429. end;
  1430. end;
  1431. function ttryfinallynode.pass_1 : tnode;
  1432. begin
  1433. result:=nil;
  1434. expectloc:=LOC_VOID;
  1435. firstpass(left);
  1436. firstpass(right);
  1437. if assigned(t1) then
  1438. firstpass(t1);
  1439. end;
  1440. function ttryfinallynode.simplify: tnode;
  1441. begin
  1442. result:=nil;
  1443. { if the try contains no code, we can kill
  1444. the try and except and return only the
  1445. finally part }
  1446. if has_no_code(left) then
  1447. begin
  1448. result:=right;
  1449. right:=nil;
  1450. end;
  1451. end;
  1452. {*****************************************************************************
  1453. TONNODE
  1454. *****************************************************************************}
  1455. constructor tonnode.create(l,r:tnode);
  1456. begin
  1457. inherited create(onn,l,r);
  1458. excepTSymtable:=nil;
  1459. excepttype:=nil;
  1460. end;
  1461. destructor tonnode.destroy;
  1462. begin
  1463. { copied nodes don't need to release the symtable }
  1464. if assigned(excepTSymtable) then
  1465. excepTSymtable.free;
  1466. inherited destroy;
  1467. end;
  1468. constructor tonnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  1469. begin
  1470. inherited ppuload(t,ppufile);
  1471. excepTSymtable:=nil;
  1472. excepttype:=nil;
  1473. end;
  1474. function tonnode.dogetcopy : tnode;
  1475. var
  1476. n : tonnode;
  1477. begin
  1478. n:=tonnode(inherited dogetcopy);
  1479. if assigned(exceptsymtable) then
  1480. n.exceptsymtable:=exceptsymtable.getcopy
  1481. else
  1482. n.exceptsymtable:=nil;
  1483. n.excepttype:=excepttype;
  1484. result:=n;
  1485. end;
  1486. function tonnode.pass_typecheck:tnode;
  1487. begin
  1488. result:=nil;
  1489. resultdef:=voidtype;
  1490. if not(is_class(excepttype)) then
  1491. CGMessage1(type_e_class_type_expected,excepttype.typename);
  1492. if assigned(left) then
  1493. typecheckpass(left);
  1494. if assigned(right) then
  1495. typecheckpass(right);
  1496. end;
  1497. function tonnode.pass_1 : tnode;
  1498. begin
  1499. result:=nil;
  1500. include(current_procinfo.flags,pi_do_call);
  1501. expectloc:=LOC_VOID;
  1502. if assigned(left) then
  1503. firstpass(left);
  1504. if assigned(right) then
  1505. firstpass(right);
  1506. end;
  1507. function tonnode.docompare(p: tnode): boolean;
  1508. begin
  1509. docompare := false;
  1510. end;
  1511. begin
  1512. cwhilerepeatnode:=twhilerepeatnode;
  1513. cifnode:=tifnode;
  1514. cfornode:=tfornode;
  1515. cexitnode:=texitnode;
  1516. cgotonode:=tgotonode;
  1517. clabelnode:=tlabelnode;
  1518. craisenode:=traisenode;
  1519. ctryexceptnode:=ttryexceptnode;
  1520. ctryfinallynode:=ttryfinallynode;
  1521. connode:=tonnode;
  1522. end.