nflw.pas 54 KB

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