nflw.pas 89 KB

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