nutils.pas 55 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598
  1. {
  2. Copyright (c) 1998-2002 by Florian Klaempfl
  3. Type checking and register allocation for inline nodes
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. unit nutils;
  18. {$i fpcdefs.inc}
  19. {$modeswitch nestedprocvars}
  20. interface
  21. uses
  22. globtype,constexp,
  23. symtype,symsym,symbase,symtable,
  24. node,compinnr;
  25. const
  26. NODE_COMPLEXITY_INF = 255;
  27. type
  28. { resultdef of functions that process on all nodes in a (sub)tree }
  29. foreachnoderesult = (
  30. { false, continue recursion }
  31. fen_false,
  32. { false, stop recursion }
  33. fen_norecurse_false,
  34. { true, continue recursion }
  35. fen_true,
  36. { true, stop recursion }
  37. fen_norecurse_true
  38. );
  39. tforeachprocmethod = ({ children are processed before the parent node }
  40. pm_preprocess,
  41. { children are processed after the parent node }
  42. pm_postprocess,
  43. { children are processed after the parent node and
  44. then the parent node is processed again }
  45. pm_postandagain);
  46. tmhs_flag = (
  47. { exceptions (overflow, sigfault etc.) are considered as side effect }
  48. mhs_exceptions
  49. );
  50. tmhs_flags = set of tmhs_flag;
  51. pmhs_flags = ^tmhs_flags;
  52. foreachnodefunction = function(var n: tnode; arg: pointer): foreachnoderesult of object;
  53. staticforeachnodefunction = function(var n: tnode; arg: pointer): foreachnoderesult;
  54. function foreachnode(var n: tnode; f: foreachnodefunction; arg: pointer): boolean;
  55. function foreachnode(procmethod : tforeachprocmethod; var n: tnode; f: foreachnodefunction; arg: pointer): boolean;
  56. function foreachnodestatic(var n: tnode; f: staticforeachnodefunction; arg: pointer): boolean;
  57. function foreachnodestatic(procmethod : tforeachprocmethod; var n: tnode; f: staticforeachnodefunction; arg: pointer): boolean;
  58. { checks if the given node tree contains only nodes of the given type,
  59. if this isn't the case, an ie is thrown
  60. }
  61. procedure checktreenodetypes(n : tnode;typeset : tnodetypeset);
  62. procedure load_procvar_from_calln(var p1:tnode);
  63. function get_local_or_para_sym(const aname: string): tsym;
  64. function maybe_call_procvar(var p1:tnode;tponly:boolean):boolean;
  65. function load_high_value_node(vs:tparavarsym):tnode;
  66. function load_self_node:tnode;
  67. function load_result_node:tnode;
  68. function load_self_pointer_node:tnode;
  69. function load_vmt_pointer_node:tnode;
  70. function is_self_node(p:tnode):boolean;
  71. { create a tree that loads the VMT based on a self-node of an object/class/
  72. interface }
  73. function load_vmt_for_self_node(self_node: tnode): tnode;
  74. function node_complexity(p: tnode): cardinal;
  75. function node_resources_fpu(p: tnode): cardinal;
  76. procedure node_tree_set_filepos(var n:tnode;const filepos:tfileposinfo);
  77. { tries to simplify the given node after inlining }
  78. procedure doinlinesimplify(var n : tnode);
  79. { creates an ordinal constant, optionally based on the result from a
  80. simplify operation: normally the type is the smallest integer type
  81. that can hold the value, but when inlining the "def" will be used instead,
  82. which was determined during an earlier typecheck pass (because the value
  83. may e.g. be a parameter to a call, which needs to be of the declared
  84. parameter type) }
  85. function create_simplified_ord_const(const value: tconstexprint; def: tdef; forinline, rangecheck: boolean): tnode;
  86. { returns true if n is only a tree of administrative nodes
  87. containing no code }
  88. function has_no_code(n : tnode) : boolean;
  89. procedure propaccesslist_to_node(var p1:tnode;st:TSymtable;pl:tpropaccesslist);
  90. function node_to_propaccesslist(p1:tnode):tpropaccesslist;
  91. { checks whether sym is a static field and if so, translates the access
  92. to the appropriate node tree }
  93. function handle_staticfield_access(sym: tsym; var p1: tnode): boolean;
  94. { returns true if n is an array element access of a bitpacked array with
  95. elements of the which the vitsize mod 8 <> 0, or if is a field access
  96. with bitsize mod 8 <> 0 or bitoffset mod 8 <> 0 of an element in a
  97. bitpacked structure }
  98. function is_bitpacked_access(n: tnode): boolean;
  99. { creates a load of field 'fieldname' in the record/class/...
  100. represented by n }
  101. function genloadfield(n: tnode; const fieldname: string): tnode;
  102. { returns true, if the tree given might have side effects }
  103. function might_have_sideeffects(n : tnode;const flags : tmhs_flags = []) : boolean;
  104. { returns true, if n contains nodes which might be conditionally executed }
  105. function has_conditional_nodes(n : tnode) : boolean;
  106. { count the number of nodes in the node tree,
  107. rough estimation how large the tree "node" is }
  108. function node_count(node : tnode) : dword;
  109. function node_count_weighted(node : tnode) : dword;
  110. { returns true, if the value described by node is constant/immutable, this approximation is safe
  111. if no dirty tricks like buffer overflows or pointer magic are used }
  112. function is_const(node : tnode) : boolean;
  113. { returns a pointer to the real node a node refers to,
  114. skipping (absolute) equal type conversions. Returning
  115. a pointer allows the caller to move/remove/replace this
  116. node
  117. }
  118. function actualtargetnode(n : pnode) : pnode;
  119. { moves src into dest, before doing so, right is set to nil and dest is freed.
  120. Because dest and src are var parameters, this can be done inline in an existing
  121. node tree }
  122. procedure replacenode(var dest,src : tnode);
  123. { strip off deref/addr combinations when looking for a the load node of an open array/array of const
  124. since there is no possiblity to defined a pointer to an open array/array of const, we have not to
  125. take care of type casts, further, it means also that deref/addr nodes must always appear coupled
  126. }
  127. function get_open_const_array(p : tnode) : tnode;
  128. { excludes the flags passed in nf from the node tree passed }
  129. procedure node_reset_flags(p : tnode;nf : tnodeflags);
  130. { include or exclude cs from p.localswitches }
  131. procedure node_change_local_switch(p : tnode;cs : tlocalswitch;enable : boolean);
  132. { returns true, if p is a node which shall be short boolean evaluated,
  133. if it is not an orn/andn with boolean operans, the result is undefined }
  134. function doshortbooleval(p : tnode) : Boolean;
  135. { returns true if the node has the int value l }
  136. function is_constintvalue(p : tnode;l : Tconstexprint) : Boolean;
  137. { returns true if the node is an inline node of type i }
  138. function is_inlinefunction(p : tnode;i : tinlinenumber) : Boolean;
  139. type
  140. TMatchProc2 = function(n1,n2 : tnode) : Boolean is nested;
  141. TTransformProc2 = function(n1,n2 : tnode) : tnode is nested;
  142. { calls matchproc with n1 and n2 as parameters, if it returns true, transformproc is called, does the same with the nodes swapped,
  143. the result of transformproc is assigned to res }
  144. function MatchAndTransformNodesCommutative(n1,n2 : tnode;matchproc : TMatchProc2;transformproc : TTransformProc2;var res : tnode) : Boolean;
  145. implementation
  146. uses
  147. cutils,verbose,globals,
  148. symconst,symdef,
  149. defcmp,defutil,
  150. nbas,ncon,ncnv,nld,nflw,nset,ncal,nadd,nmem,ninl,
  151. cpubase,cgbase,procinfo,
  152. pass_1;
  153. function foreachnode(procmethod : tforeachprocmethod;var n: tnode; f: foreachnodefunction; arg: pointer): boolean;
  154. function process_children(res : boolean) : boolean;
  155. var
  156. i: longint;
  157. begin
  158. result:=res;
  159. case n.nodetype of
  160. asn:
  161. if assigned(tasnode(n).call) then
  162. begin
  163. result := foreachnode(procmethod,tasnode(n).call,f,arg);
  164. exit
  165. end;
  166. calln:
  167. begin
  168. result := foreachnode(procmethod,tnode(tcallnode(n).callinitblock),f,arg) or result;
  169. result := foreachnode(procmethod,tcallnode(n).methodpointer,f,arg) or result;
  170. result := foreachnode(procmethod,tcallnode(n).funcretnode,f,arg) or result;
  171. result := foreachnode(procmethod,tnode(tcallnode(n).callcleanupblock),f,arg) or result;
  172. end;
  173. ifn, whilerepeatn, forn, tryexceptn:
  174. begin
  175. { not in one statement, won't work because of b- }
  176. result := foreachnode(procmethod,tloopnode(n).t1,f,arg) or result;
  177. result := foreachnode(procmethod,tloopnode(n).t2,f,arg) or result;
  178. end;
  179. raisen, tryfinallyn:
  180. { frame tree/copy of finally code }
  181. result := foreachnode(ttertiarynode(n).third,f,arg) or result;
  182. tempcreaten:
  183. { temp. initialization code }
  184. if assigned(ttempcreatenode(n).tempinfo^.tempinitcode) then
  185. result := foreachnode(ttempcreatenode(n).tempinfo^.tempinitcode,f,arg) or result;
  186. casen:
  187. begin
  188. for i := 0 to tcasenode(n).blocks.count-1 do
  189. if assigned(tcasenode(n).blocks[i]) then
  190. result := foreachnode(procmethod,pcaseblock(tcasenode(n).blocks[i])^.statement,f,arg) or result;
  191. result := foreachnode(procmethod,tcasenode(n).elseblock,f,arg) or result;
  192. end;
  193. else
  194. ;
  195. end;
  196. if n.inheritsfrom(tbinarynode) then
  197. begin
  198. { first process the "payload" of statementnodes }
  199. result := foreachnode(procmethod,tbinarynode(n).left,f,arg) or result;
  200. result := foreachnode(procmethod,tbinarynode(n).right,f,arg) or result;
  201. end
  202. else if n.inheritsfrom(tunarynode) then
  203. result := foreachnode(procmethod,tunarynode(n).left,f,arg) or result;
  204. end;
  205. begin
  206. result := false;
  207. if not assigned(n) then
  208. exit;
  209. if procmethod=pm_preprocess then
  210. result:=process_children(result);
  211. case f(n,arg) of
  212. fen_norecurse_false:
  213. exit;
  214. fen_norecurse_true:
  215. begin
  216. result := true;
  217. exit;
  218. end;
  219. fen_true:
  220. result := true;
  221. { result is already false
  222. fen_false:
  223. result := false; }
  224. else
  225. ;
  226. end;
  227. if (procmethod=pm_postprocess) or (procmethod=pm_postandagain) then
  228. result:=process_children(result);
  229. if procmethod=pm_postandagain then
  230. begin
  231. case f(n,arg) of
  232. fen_norecurse_false:
  233. exit;
  234. fen_norecurse_true:
  235. begin
  236. result := true;
  237. exit;
  238. end;
  239. fen_true:
  240. result := true;
  241. else
  242. ;
  243. end;
  244. end;
  245. end;
  246. function foreachnode(var n: tnode; f: foreachnodefunction; arg: pointer): boolean;
  247. begin
  248. result:=foreachnode(pm_postprocess,n,f,arg);
  249. end;
  250. function foreachnodestatic(procmethod : tforeachprocmethod;var n: tnode; f: staticforeachnodefunction; arg: pointer): boolean;
  251. function process_children(res : boolean) : boolean;
  252. var
  253. i: longint;
  254. begin
  255. result:=res;
  256. case n.nodetype of
  257. asn:
  258. if assigned(tasnode(n).call) then
  259. begin
  260. result := foreachnodestatic(procmethod,tasnode(n).call,f,arg);
  261. exit
  262. end;
  263. calln:
  264. begin
  265. result := foreachnodestatic(procmethod,tnode(tcallnode(n).callinitblock),f,arg) or result;
  266. result := foreachnodestatic(procmethod,tcallnode(n).methodpointer,f,arg) or result;
  267. result := foreachnodestatic(procmethod,tcallnode(n).funcretnode,f,arg) or result;
  268. result := foreachnodestatic(procmethod,tnode(tcallnode(n).callcleanupblock),f,arg) or result;
  269. end;
  270. ifn, whilerepeatn, forn, tryexceptn:
  271. begin
  272. { not in one statement, won't work because of b- }
  273. result := foreachnodestatic(procmethod,tloopnode(n).t1,f,arg) or result;
  274. result := foreachnodestatic(procmethod,tloopnode(n).t2,f,arg) or result;
  275. end;
  276. raisen, tryfinallyn:
  277. { frame tree/copy of finally code }
  278. result := foreachnodestatic(ttertiarynode(n).third,f,arg) or result;
  279. tempcreaten:
  280. { temp. initialization code }
  281. if assigned(ttempcreatenode(n).tempinfo^.tempinitcode) then
  282. result := foreachnodestatic(ttempcreatenode(n).tempinfo^.tempinitcode,f,arg) or result;
  283. casen:
  284. begin
  285. for i := 0 to tcasenode(n).blocks.count-1 do
  286. if assigned(tcasenode(n).blocks[i]) then
  287. result := foreachnodestatic(procmethod,pcaseblock(tcasenode(n).blocks[i])^.statement,f,arg) or result;
  288. result := foreachnodestatic(procmethod,tcasenode(n).elseblock,f,arg) or result;
  289. end;
  290. else
  291. ;
  292. end;
  293. if n.inheritsfrom(tbinarynode) then
  294. begin
  295. { first process the "payload" of statementnodes }
  296. result := foreachnodestatic(procmethod,tbinarynode(n).left,f,arg) or result;
  297. result := foreachnodestatic(procmethod,tbinarynode(n).right,f,arg) or result;
  298. end
  299. else if n.inheritsfrom(tunarynode) then
  300. result := foreachnodestatic(procmethod,tunarynode(n).left,f,arg) or result;
  301. end;
  302. begin
  303. result := false;
  304. if not assigned(n) then
  305. exit;
  306. if procmethod=pm_preprocess then
  307. result:=process_children(result);
  308. case f(n,arg) of
  309. fen_norecurse_false:
  310. exit;
  311. fen_norecurse_true:
  312. begin
  313. result := true;
  314. exit;
  315. end;
  316. fen_true:
  317. result := true;
  318. { result is already false
  319. fen_false:
  320. result := false; }
  321. else
  322. ;
  323. end;
  324. if (procmethod=pm_postprocess) or (procmethod=pm_postandagain) then
  325. result:=process_children(result);
  326. if procmethod=pm_postandagain then
  327. begin
  328. case f(n,arg) of
  329. fen_norecurse_false:
  330. exit;
  331. fen_norecurse_true:
  332. begin
  333. result := true;
  334. exit;
  335. end;
  336. fen_true:
  337. result := true;
  338. else
  339. ;
  340. end;
  341. end;
  342. end;
  343. function foreachnodestatic(var n: tnode; f: staticforeachnodefunction; arg: pointer): boolean;
  344. begin
  345. result:=foreachnodestatic(pm_postprocess,n,f,arg);
  346. end;
  347. function do_check(var n: tnode; arg: pointer): foreachnoderesult;
  348. begin
  349. if not(n.nodetype in pnodetypeset(arg)^) then
  350. internalerror(200610141);
  351. result:=fen_true;
  352. end;
  353. procedure checktreenodetypes(n : tnode;typeset : tnodetypeset);
  354. begin
  355. foreachnodestatic(n,@do_check,@typeset);
  356. end;
  357. procedure load_procvar_from_calln(var p1:tnode);
  358. var
  359. p2 : tnode;
  360. begin
  361. if p1.nodetype<>calln then
  362. internalerror(200212251);
  363. { was it a procvar, then we simply remove the calln and
  364. reuse the right }
  365. if assigned(tcallnode(p1).right) then
  366. begin
  367. p2:=tcallnode(p1).right;
  368. tcallnode(p1).right:=nil;
  369. end
  370. else
  371. begin
  372. p2:=cloadnode.create_procvar(tcallnode(p1).symtableprocentry,
  373. tprocdef(tcallnode(p1).procdefinition),tcallnode(p1).symtableproc);
  374. { when the methodpointer is typen we've something like:
  375. tobject.create. Then only the address is needed of the
  376. method without a self pointer }
  377. if assigned(tcallnode(p1).methodpointer) and
  378. (tcallnode(p1).methodpointer.nodetype<>typen) then
  379. tloadnode(p2).set_mp(tcallnode(p1).methodpointer.getcopy);
  380. end;
  381. typecheckpass(p2);
  382. p1.free;
  383. p1:=p2;
  384. end;
  385. function maybe_call_procvar(var p1:tnode;tponly:boolean):boolean;
  386. var
  387. hp : tnode;
  388. begin
  389. result:=false;
  390. if (p1.resultdef.typ<>procvardef) or
  391. (tponly and
  392. not(m_tp_procvar in current_settings.modeswitches)) then
  393. exit;
  394. { ignore vecn,subscriptn }
  395. hp:=p1;
  396. repeat
  397. case hp.nodetype of
  398. vecn,
  399. derefn,
  400. typeconvn,
  401. subscriptn :
  402. hp:=tunarynode(hp).left;
  403. blockn:
  404. hp:=laststatement(tblocknode(hp)).left
  405. else
  406. break;
  407. end;
  408. until false;
  409. { a tempref is used when it is loaded from a withsymtable }
  410. if (hp.nodetype in [calln,loadn,temprefn]) then
  411. begin
  412. hp:=ccallnode.create_procvar(nil,p1);
  413. typecheckpass(hp);
  414. p1:=hp;
  415. result:=true;
  416. end;
  417. end;
  418. function get_local_or_para_sym(const aname: string): tsym;
  419. var
  420. pd : tprocdef;
  421. begin
  422. result:=nil;
  423. { is not assigned while parsing a property }
  424. if not assigned(current_procinfo) then
  425. exit;
  426. { we can't use searchsym here, because the
  427. symtablestack is not fully setup when pass1
  428. is run for nested procedures }
  429. pd:=current_procinfo.procdef;
  430. repeat
  431. result := tsym(pd.localst.Find(aname));
  432. if assigned(result) then
  433. break;
  434. result := tsym(pd.parast.Find(aname));
  435. if assigned(result) then
  436. break;
  437. { try the parent of a nested function }
  438. if assigned(pd.owner.defowner) and
  439. (pd.owner.defowner.typ=procdef) then
  440. pd:=tprocdef(pd.owner.defowner)
  441. else
  442. break;
  443. until false;
  444. end;
  445. function load_high_value_node(vs:tparavarsym):tnode;
  446. var
  447. srsym : tsym;
  448. begin
  449. result:=nil;
  450. srsym:=get_high_value_sym(vs);
  451. if assigned(srsym) then
  452. begin
  453. result:=cloadnode.create(srsym,vs.owner);
  454. typecheckpass(result);
  455. end
  456. else
  457. CGMessage(parser_e_illegal_expression);
  458. end;
  459. function load_self_node:tnode;
  460. var
  461. srsym : tsym;
  462. begin
  463. result:=nil;
  464. srsym:=get_local_or_para_sym('self');
  465. if assigned(srsym) then
  466. begin
  467. result:=cloadnode.create(srsym,srsym.owner);
  468. include(tloadnode(result).loadnodeflags,loadnf_is_self);
  469. end
  470. else
  471. begin
  472. result:=cerrornode.create;
  473. CGMessage(parser_e_illegal_expression);
  474. end;
  475. typecheckpass(result);
  476. end;
  477. function load_result_node:tnode;
  478. var
  479. srsym : tsym;
  480. begin
  481. result:=nil;
  482. srsym:=get_local_or_para_sym('result');
  483. if assigned(srsym) then
  484. result:=cloadnode.create(srsym,srsym.owner)
  485. else
  486. begin
  487. result:=cerrornode.create;
  488. CGMessage(parser_e_illegal_expression);
  489. end;
  490. typecheckpass(result);
  491. end;
  492. function load_self_pointer_node:tnode;
  493. var
  494. srsym : tsym;
  495. begin
  496. result:=nil;
  497. srsym:=get_local_or_para_sym('self');
  498. if assigned(srsym) then
  499. begin
  500. result:=cloadnode.create(srsym,srsym.owner);
  501. if is_object(tabstractvarsym(srsym).vardef) or is_record(tabstractvarsym(srsym).vardef) then
  502. include(tloadnode(result).loadnodeflags,loadnf_load_addr);
  503. end
  504. else
  505. begin
  506. result:=cerrornode.create;
  507. CGMessage(parser_e_illegal_expression);
  508. end;
  509. typecheckpass(result);
  510. end;
  511. function load_vmt_pointer_node:tnode;
  512. var
  513. srsym : tsym;
  514. begin
  515. result:=nil;
  516. srsym:=get_local_or_para_sym('vmt');
  517. if assigned(srsym) then
  518. result:=cloadnode.create(srsym,srsym.owner)
  519. else
  520. begin
  521. result:=cerrornode.create;
  522. CGMessage(parser_e_illegal_expression);
  523. end;
  524. typecheckpass(result);
  525. end;
  526. function is_self_node(p:tnode):boolean;
  527. begin
  528. is_self_node:=(p.nodetype=loadn) and
  529. (tloadnode(p).symtableentry.typ=paravarsym) and
  530. (vo_is_self in tparavarsym(tloadnode(p).symtableentry).varoptions);
  531. end;
  532. function load_vmt_for_self_node(self_node: tnode): tnode;
  533. var
  534. self_resultdef: tdef;
  535. obj_def: tobjectdef;
  536. self_temp,
  537. vmt_temp: ttempcreatenode;
  538. check_self,n: tnode;
  539. stat: tstatementnode;
  540. block: tblocknode;
  541. paras: tcallparanode;
  542. docheck,is_typecasted_classref: boolean;
  543. begin
  544. self_resultdef:=self_node.resultdef;
  545. case self_resultdef.typ of
  546. classrefdef:
  547. begin
  548. obj_def:=tobjectdef(tclassrefdef(self_resultdef).pointeddef);
  549. end;
  550. objectdef:
  551. obj_def:=tobjectdef(self_resultdef);
  552. else
  553. internalerror(2015052701);
  554. end;
  555. n:=self_node;
  556. is_typecasted_classref:=false;
  557. if (n.nodetype=typeconvn) then
  558. begin
  559. while assigned(n) and (n.nodetype=typeconvn) and (nf_explicit in ttypeconvnode(n).flags) do
  560. n:=ttypeconvnode(n).left;
  561. if assigned(n) and (n.resultdef.typ=classrefdef) then
  562. is_typecasted_classref:=true;
  563. end;
  564. if is_classhelper(obj_def) then
  565. obj_def:=tobjectdef(tobjectdef(obj_def).extendeddef);
  566. docheck:=
  567. not(is_interface(obj_def)) and
  568. not(is_cppclass(obj_def)) and
  569. not(is_objc_class_or_protocol(obj_def)) and
  570. (([cs_check_object,cs_check_range]*current_settings.localswitches)<>[]);
  571. block:=nil;
  572. stat:=nil;
  573. self_temp:=nil;
  574. if docheck then
  575. begin
  576. { check for nil self-pointer }
  577. block:=internalstatements(stat);
  578. if is_object(self_resultdef) then
  579. begin
  580. self_temp:=ctempcreatenode.create_value(
  581. cpointerdef.getreusable(self_resultdef),cpointerdef.getreusable(self_resultdef).size,tt_persistent,true,
  582. caddrnode.create(self_node));
  583. end
  584. else
  585. self_temp:=ctempcreatenode.create_value(
  586. self_resultdef,self_resultdef.size,tt_persistent,true,
  587. self_node);
  588. addstatement(stat,self_temp);
  589. { in case of an object, self can only be nil if it's a dereferenced
  590. node somehow
  591. }
  592. if not is_object(self_resultdef) or
  593. (actualtargetnode(@self_node)^.nodetype=derefn) then
  594. begin
  595. check_self:=ctemprefnode.create(self_temp);
  596. addstatement(stat,cifnode.create(
  597. caddnode.create(equaln,
  598. ctypeconvnode.create_explicit(
  599. check_self,
  600. voidpointertype
  601. ),
  602. cnilnode.create),
  603. ccallnode.createintern('fpc_objecterror',nil),
  604. nil)
  605. );
  606. end;
  607. if is_object(self_resultdef) then
  608. self_node:=cderefnode.create(ctemprefnode.create(self_temp))
  609. else
  610. self_node:=ctemprefnode.create(self_temp)
  611. end;
  612. { in case of a classref, the "instance" is a pointer
  613. to pointer to a VMT and there is no vmt field }
  614. if is_typecasted_classref or (self_resultdef.typ=classrefdef) then
  615. result:=self_node
  616. { get the VMT field in case of a class/object }
  617. else if (self_resultdef.typ=objectdef) and
  618. assigned(tobjectdef(self_resultdef).vmt_field) then
  619. result:=csubscriptnode.create(tobjectdef(self_resultdef).vmt_field,self_node)
  620. { in case of an interface, the "instance" is a pointer to a pointer
  621. to a VMT -> dereference once already }
  622. else
  623. { in case of an interface/classref, the "instance" is a pointer
  624. to pointer to a VMT and there is no vmt field }
  625. result:=cderefnode.create(
  626. ctypeconvnode.create_explicit(
  627. self_node,
  628. cpointerdef.getreusable(voidpointertype)
  629. )
  630. );
  631. result:=ctypeconvnode.create_explicit(
  632. result,
  633. cpointerdef.getreusable(obj_def.vmt_def));
  634. typecheckpass(result);
  635. if docheck then
  636. begin
  637. { add a vmt validity check }
  638. vmt_temp:=ctempcreatenode.create_value(result.resultdef,result.resultdef.size,tt_persistent,true,result);
  639. addstatement(stat,vmt_temp);
  640. paras:=ccallparanode.create(ctemprefnode.create(vmt_temp),nil);
  641. if cs_check_object in current_settings.localswitches then
  642. begin
  643. paras:=ccallparanode.create(
  644. cloadvmtaddrnode.create(ctypenode.create(obj_def)),
  645. paras
  646. );
  647. addstatement(stat,
  648. ccallnode.createintern(
  649. 'fpc_check_object_ext',paras
  650. )
  651. );
  652. end
  653. else
  654. addstatement(stat,
  655. ccallnode.createintern(
  656. 'fpc_check_object',paras
  657. )
  658. );
  659. addstatement(stat,ctempdeletenode.create_normal_temp(vmt_temp));
  660. addstatement(stat,ctempdeletenode.create(self_temp));
  661. addstatement(stat,ctemprefnode.create(vmt_temp));
  662. result:=block;
  663. end
  664. end;
  665. { this function must return a very high value ("infinity") for }
  666. { trees containing a call, the rest can be balanced more or less }
  667. { at will, probably best mainly in terms of required memory }
  668. { accesses }
  669. function node_complexity(p: tnode): cardinal;
  670. var
  671. correction: byte;
  672. {$ifdef ARM}
  673. dummy : byte;
  674. {$endif ARM}
  675. begin
  676. result := 0;
  677. while assigned(p) do
  678. begin
  679. case p.nodetype of
  680. { floating point constants usually need loading from memory }
  681. realconstn:
  682. begin
  683. result:=2;
  684. exit;
  685. end;
  686. rttin,
  687. setconstn,
  688. stringconstn,
  689. temprefn,
  690. loadvmtaddrn,
  691. { main reason for the next one: we can't take the address of }
  692. { loadparentfpnode, so replacing it by a temp which is the }
  693. { address of this node's location and then dereferencing }
  694. { doesn't work. If changed, check whether webtbs/tw0935 }
  695. { still works with nodeinlining (JM) }
  696. loadparentfpn:
  697. begin
  698. result := 1;
  699. exit;
  700. end;
  701. loadn:
  702. begin
  703. if assigned(tloadnode(p).left) then
  704. inc(result,node_complexity(tloadnode(p).left));
  705. { threadvars need a helper call }
  706. if (tloadnode(p).symtableentry.typ=staticvarsym) and
  707. (vo_is_thread_var in tstaticvarsym(tloadnode(p).symtableentry).varoptions) then
  708. inc(result,5)
  709. else if not((tloadnode(p).symtableentry.typ in [staticvarsym,localvarsym,paravarsym,fieldvarsym]) and
  710. (tabstractvarsym(tloadnode(p).symtableentry).varregable in [vr_intreg,vr_mmreg,vr_fpureg])) then
  711. inc(result);
  712. if (tloadnode(p).symtableentry.typ=paravarsym) and
  713. not(tabstractvarsym(tloadnode(p).symtableentry).varregable=vr_addr) and
  714. tloadnode(p).is_addr_param_load then
  715. inc(result);
  716. if (result >= NODE_COMPLEXITY_INF) then
  717. result := NODE_COMPLEXITY_INF;
  718. exit;
  719. end;
  720. subscriptn:
  721. begin
  722. if is_implicit_pointer_object_type(tunarynode(p).left.resultdef) or
  723. is_bitpacked_access(p) then
  724. inc(result,2)
  725. { non-packed, int. regable records cause no extra
  726. overhead no overhead if the fields are aligned to register boundaries }
  727. else if tstoreddef(p.resultdef).is_intregable and (tsubscriptnode(p).vs.fieldoffset mod sizeof(aint)<>0) then
  728. inc(result,1);
  729. if (result = NODE_COMPLEXITY_INF) then
  730. exit;
  731. p := tunarynode(p).left;
  732. end;
  733. labeln,
  734. blockn:
  735. p := tunarynode(p).left;
  736. callparan:
  737. begin
  738. { call to decr? }
  739. if is_managed_type(tunarynode(p).left.resultdef) and
  740. assigned(tcallparanode(p).parasym) and (tcallparanode(p).parasym.varspez=vs_out) then
  741. begin
  742. result:=NODE_COMPLEXITY_INF;
  743. exit;
  744. end
  745. else
  746. begin
  747. inc(result);
  748. if (result = NODE_COMPLEXITY_INF) then
  749. exit;
  750. p := tunarynode(p).left;
  751. end;
  752. end;
  753. notn,
  754. derefn :
  755. begin
  756. inc(result);
  757. if (result = NODE_COMPLEXITY_INF) then
  758. exit;
  759. p := tunarynode(p).left;
  760. end;
  761. addrn:
  762. begin
  763. inc(result);
  764. if (result = NODE_COMPLEXITY_INF) then
  765. exit;
  766. p := tunarynode(p).left;
  767. end;
  768. typeconvn:
  769. begin
  770. { may be more complex in some cases }
  771. if not(ttypeconvnode(p).retains_value_location) and
  772. not((ttypeconvnode(p).convtype=tc_pointer_2_array) and (ttypeconvnode(p).left.expectloc in [LOC_CREGISTER,LOC_REGISTER,LOC_CONSTANT])) then
  773. inc(result);
  774. if result = NODE_COMPLEXITY_INF then
  775. exit;
  776. p := tunarynode(p).left;
  777. end;
  778. vecn,
  779. statementn:
  780. begin
  781. inc(result,node_complexity(tbinarynode(p).left));
  782. if (result >= NODE_COMPLEXITY_INF) then
  783. begin
  784. result := NODE_COMPLEXITY_INF;
  785. exit;
  786. end;
  787. p := tbinarynode(p).right;
  788. end;
  789. addn,subn,orn,andn,xorn,muln,divn,modn,symdifn,
  790. shln,shrn,
  791. equaln,unequaln,gtn,gten,ltn,lten,
  792. assignn:
  793. begin
  794. {$ifdef CPU64BITALU}
  795. correction:=1;
  796. {$else CPU64BITALU}
  797. correction:=2;
  798. {$endif CPU64BITALU}
  799. inc(result,node_complexity(tbinarynode(p).left)+1*correction);
  800. if (p.nodetype in [muln,divn,modn]) then
  801. inc(result,5*correction*correction);
  802. if (result >= NODE_COMPLEXITY_INF) then
  803. begin
  804. result := NODE_COMPLEXITY_INF;
  805. exit;
  806. end;
  807. p := tbinarynode(p).right;
  808. end;
  809. ordconstn:
  810. begin
  811. {$ifdef ARM}
  812. if not(is_shifter_const(aint(tordconstnode(p).value.svalue),dummy)) then
  813. result:=2;
  814. {$endif ARM}
  815. exit;
  816. end;
  817. exitn:
  818. begin
  819. inc(result,2);
  820. if (result >= NODE_COMPLEXITY_INF) then
  821. begin
  822. result := NODE_COMPLEXITY_INF;
  823. exit;
  824. end;
  825. p:=texitnode(p).left;
  826. end;
  827. tempcreaten,
  828. tempdeleten,
  829. pointerconstn,
  830. nothingn,
  831. niln:
  832. exit;
  833. inlinen:
  834. begin
  835. { this code assumes that the inline node has }
  836. { already been firstpassed, and consequently }
  837. { that inline nodes which are transformed into }
  838. { calls already have been transformed }
  839. case tinlinenode(p).inlinenumber of
  840. in_lo_qword,
  841. in_hi_qword,
  842. in_lo_long,
  843. in_hi_long,
  844. in_lo_word,
  845. in_hi_word,
  846. in_length_x,
  847. in_assigned_x,
  848. in_pred_x,
  849. in_succ_x,
  850. in_round_real,
  851. in_trunc_real,
  852. in_int_real,
  853. in_frac_real,
  854. in_pi_real,
  855. in_abs_real,
  856. in_aligned_x,
  857. in_unaligned_x,
  858. in_volatile_x,
  859. in_prefetch_var:
  860. begin
  861. inc(result);
  862. p:=tunarynode(p).left;
  863. end;
  864. in_cos_real,
  865. in_sin_real,
  866. in_arctan_real,
  867. in_sqr_real,
  868. in_sqrt_real,
  869. in_ln_real:
  870. begin
  871. inc(result,2);
  872. if (result >= NODE_COMPLEXITY_INF) then
  873. begin
  874. result:=NODE_COMPLEXITY_INF;
  875. exit;
  876. end;
  877. p:=tunarynode(p).left;
  878. end;
  879. in_abs_long:
  880. begin
  881. inc(result,3);
  882. if (result >= NODE_COMPLEXITY_INF) then
  883. begin
  884. result:=NODE_COMPLEXITY_INF;
  885. exit;
  886. end;
  887. p:=tunarynode(p).left;
  888. end;
  889. in_sizeof_x,
  890. in_typeof_x:
  891. begin
  892. inc(result);
  893. if (tinlinenode(p).left.nodetype<>typen) then
  894. { get instance vmt }
  895. p:=tunarynode(p).left
  896. else
  897. { type vmt = global symbol, result is }
  898. { already increased above }
  899. exit;
  900. end;
  901. {$ifdef SUPPORT_MMX}
  902. in_mmx_pcmpeqb..in_mmx_pcmpgtw,
  903. {$endif SUPPORT_MMX}
  904. { load from global symbol }
  905. in_typeinfo_x,
  906. { load frame pointer }
  907. in_get_frame,
  908. in_get_caller_frame,
  909. in_get_caller_addr:
  910. begin
  911. inc(result);
  912. exit;
  913. end;
  914. in_inc_x,
  915. in_dec_x,
  916. in_include_x_y,
  917. in_exclude_x_y,
  918. in_assert_x_y :
  919. begin
  920. { operation (add, sub, or, and }
  921. inc(result);
  922. { left expression }
  923. inc(result,node_complexity(tcallparanode(tunarynode(p).left).left));
  924. if (result >= NODE_COMPLEXITY_INF) then
  925. begin
  926. result := NODE_COMPLEXITY_INF;
  927. exit;
  928. end;
  929. p:=tcallparanode(tunarynode(p).left).right;
  930. if assigned(p) then
  931. p:=tcallparanode(p).left;
  932. end;
  933. else
  934. begin
  935. result := NODE_COMPLEXITY_INF;
  936. exit;
  937. end;
  938. end;
  939. end;
  940. finalizetempsn:
  941. begin
  942. result:=NODE_COMPLEXITY_INF;
  943. exit;
  944. end;
  945. else
  946. begin
  947. result := NODE_COMPLEXITY_INF;
  948. exit;
  949. end;
  950. end;
  951. end;
  952. end;
  953. { this function returns an indication how much fpu registers
  954. will be required.
  955. Note: The algorithms need to be pessimistic to prevent a
  956. fpu stack overflow on i386 }
  957. function node_resources_fpu(p: tnode): cardinal;
  958. var
  959. res1,res2,res3 : cardinal;
  960. begin
  961. result:=0;
  962. res1:=0;
  963. res2:=0;
  964. res3:=0;
  965. if p.inheritsfrom(tunarynode) then
  966. begin
  967. if assigned(tunarynode(p).left) then
  968. res1:=node_resources_fpu(tunarynode(p).left);
  969. if p.inheritsfrom(tbinarynode) then
  970. begin
  971. if assigned(tbinarynode(p).right) then
  972. res2:=node_resources_fpu(tbinarynode(p).right);
  973. if p.inheritsfrom(ttertiarynode) and assigned(ttertiarynode(p).third) then
  974. res3:=node_resources_fpu(ttertiarynode(p).third)
  975. end;
  976. end;
  977. result:=max(max(res1,res2),res3);
  978. case p.nodetype of
  979. calln:
  980. { it could be a recursive call, so we never really know the number of used fpu registers }
  981. result:=maxfpuregs;
  982. realconstn,
  983. typeconvn,
  984. loadn :
  985. begin
  986. if p.expectloc in [LOC_CFPUREGISTER,LOC_FPUREGISTER] then
  987. result:=max(result,1);
  988. end;
  989. assignn,
  990. addn,subn,muln,slashn,
  991. equaln,unequaln,gtn,gten,ltn,lten :
  992. begin
  993. if (tbinarynode(p).left.expectloc in [LOC_CFPUREGISTER,LOC_FPUREGISTER]) or
  994. (tbinarynode(p).right.expectloc in [LOC_CFPUREGISTER,LOC_FPUREGISTER])then
  995. result:=max(result,2);
  996. if(p.expectloc in [LOC_CFPUREGISTER,LOC_FPUREGISTER]) then
  997. inc(result);
  998. end;
  999. else
  1000. ;
  1001. end;
  1002. end;
  1003. function setnodefilepos(var n: tnode; arg: pointer): foreachnoderesult;
  1004. begin
  1005. result:=fen_true;
  1006. n.fileinfo:=pfileposinfo(arg)^;
  1007. end;
  1008. procedure node_tree_set_filepos(var n:tnode;const filepos:tfileposinfo);
  1009. begin
  1010. foreachnodestatic(n,@setnodefilepos,@filepos);
  1011. end;
  1012. function callsimplify(var n: tnode; arg: pointer): foreachnoderesult;
  1013. var
  1014. hn : tnode;
  1015. treechanged : ^boolean;
  1016. begin
  1017. result:=fen_false;
  1018. if n.inheritsfrom(tloopnode) and
  1019. not (lnf_simplify_processing in tloopnode(n).loopflags) then
  1020. begin
  1021. // Try to simplify condition
  1022. doinlinesimplify(tloopnode(n).left);
  1023. // call directly second part below,
  1024. // which might change the loopnode into
  1025. // something else if the conditino is a constant node
  1026. include(tloopnode(n).loopflags,lnf_simplify_processing);
  1027. callsimplify(n,arg);
  1028. // Be careful, n might have change node type
  1029. if n.inheritsfrom(tloopnode) then
  1030. exclude(tloopnode(n).loopflags,lnf_simplify_processing);
  1031. end
  1032. else
  1033. begin
  1034. hn:=n.simplify(true);
  1035. if assigned(hn) then
  1036. begin
  1037. treechanged := arg;
  1038. if assigned(treechanged) then
  1039. treechanged^:=true
  1040. else
  1041. internalerror (201008181);
  1042. n.free;
  1043. n:=hn;
  1044. typecheckpass(n);
  1045. end;
  1046. end;
  1047. end;
  1048. { tries to simplify the given node calling the simplify method recursively }
  1049. procedure doinlinesimplify(var n : tnode);
  1050. var
  1051. treechanged : boolean;
  1052. begin
  1053. // Optimize if code first
  1054. repeat
  1055. treechanged:=false;
  1056. foreachnodestatic(pm_postandagain,n,@callsimplify,@treechanged);
  1057. until not(treechanged);
  1058. end;
  1059. function create_simplified_ord_const(const value: tconstexprint; def: tdef; forinline, rangecheck: boolean): tnode;
  1060. begin
  1061. if not forinline then
  1062. result:=genintconstnode(value)
  1063. else
  1064. result:=cordconstnode.create(value,def,rangecheck);
  1065. end;
  1066. procedure propaccesslist_to_node(var p1:tnode;st:TSymtable;pl:tpropaccesslist);
  1067. var
  1068. plist : ppropaccesslistitem;
  1069. begin
  1070. plist:=pl.firstsym;
  1071. while assigned(plist) do
  1072. begin
  1073. case plist^.sltype of
  1074. sl_load :
  1075. begin
  1076. addsymref(plist^.sym);
  1077. if not assigned(st) then
  1078. st:=plist^.sym.owner;
  1079. if (plist^.sym.typ<>staticvarsym) then
  1080. begin
  1081. { p1 can already contain the loadnode of
  1082. the class variable. When there is no tree yet we
  1083. may need to load it for with or objects }
  1084. if not assigned(p1) then
  1085. begin
  1086. case st.symtabletype of
  1087. withsymtable :
  1088. p1:=tnode(twithsymtable(st).withrefnode).getcopy;
  1089. ObjectSymtable :
  1090. p1:=load_self_node;
  1091. else
  1092. ;
  1093. end;
  1094. end
  1095. end
  1096. else
  1097. begin
  1098. p1.free;
  1099. p1:=nil;
  1100. end;
  1101. if assigned(p1) then
  1102. p1:=csubscriptnode.create(plist^.sym,p1)
  1103. else
  1104. p1:=cloadnode.create(plist^.sym,st);
  1105. end;
  1106. sl_subscript :
  1107. begin
  1108. addsymref(plist^.sym);
  1109. p1:=csubscriptnode.create(plist^.sym,p1);
  1110. end;
  1111. sl_typeconv :
  1112. p1:=ctypeconvnode.create_explicit(p1,plist^.def);
  1113. sl_absolutetype :
  1114. begin
  1115. p1:=ctypeconvnode.create(p1,plist^.def);
  1116. include(p1.flags,nf_absolute);
  1117. end;
  1118. sl_vec :
  1119. p1:=cvecnode.create(p1,cordconstnode.create(plist^.value,plist^.valuedef,true));
  1120. else
  1121. internalerror(200110205);
  1122. end;
  1123. plist:=plist^.next;
  1124. end;
  1125. end;
  1126. function node_to_propaccesslist(p1:tnode):tpropaccesslist;
  1127. var
  1128. sl : tpropaccesslist;
  1129. procedure addnode(p:tnode);
  1130. begin
  1131. case p.nodetype of
  1132. subscriptn :
  1133. begin
  1134. addnode(tsubscriptnode(p).left);
  1135. sl.addsym(sl_subscript,tsubscriptnode(p).vs);
  1136. end;
  1137. typeconvn :
  1138. begin
  1139. addnode(ttypeconvnode(p).left);
  1140. if nf_absolute in ttypeconvnode(p).flags then
  1141. sl.addtype(sl_absolutetype,ttypeconvnode(p).totypedef)
  1142. else
  1143. sl.addtype(sl_typeconv,ttypeconvnode(p).totypedef);
  1144. end;
  1145. vecn :
  1146. begin
  1147. addnode(tvecnode(p).left);
  1148. if tvecnode(p).right.nodetype=ordconstn then
  1149. sl.addconst(sl_vec,tordconstnode(tvecnode(p).right).value,tvecnode(p).right.resultdef)
  1150. else
  1151. begin
  1152. Message(parser_e_illegal_expression);
  1153. { recovery }
  1154. sl.addconst(sl_vec,0,tvecnode(p).right.resultdef);
  1155. end;
  1156. end;
  1157. loadn :
  1158. sl.addsym(sl_load,tloadnode(p).symtableentry);
  1159. else
  1160. internalerror(200310282);
  1161. end;
  1162. end;
  1163. begin
  1164. sl:=tpropaccesslist.create;
  1165. addnode(p1);
  1166. result:=sl;
  1167. end;
  1168. function handle_staticfield_access(sym: tsym; var p1: tnode): boolean;
  1169. function handle_generic_staticfield_access:boolean;
  1170. var
  1171. tmp : tstoreddef;
  1172. pd : tprocdef;
  1173. begin
  1174. { in case we have a specialization inside a generic (thus the static var sym does not
  1175. exist) we simply simulate a non static access to avoid unnecessary errors }
  1176. if assigned(sym.owner.defowner) and (df_specialization in tstoreddef(sym.owner.defowner).defoptions) then
  1177. begin
  1178. tmp:=tstoreddef(sym.owner.defowner);
  1179. while assigned(tmp) do
  1180. begin
  1181. if df_generic in tmp.defoptions then
  1182. begin
  1183. p1.free;
  1184. if assigned(current_procinfo) then
  1185. begin
  1186. pd:=current_procinfo.get_normal_proc.procdef;
  1187. if assigned(pd) and pd.no_self_node then
  1188. p1:=cloadvmtaddrnode.create(ctypenode.create(pd.struct))
  1189. else
  1190. p1:=load_self_node;
  1191. end
  1192. else
  1193. p1:=load_self_node;
  1194. p1:=csubscriptnode.create(sym,p1);
  1195. exit(true);
  1196. end;
  1197. tmp:=tstoreddef(tmp.owner.defowner);
  1198. end;
  1199. end;
  1200. result:=false;
  1201. end;
  1202. var
  1203. static_name: shortstring;
  1204. srsymtable: tsymtable;
  1205. begin
  1206. result:=false;
  1207. { generate access code }
  1208. if (sp_static in sym.symoptions) then
  1209. begin
  1210. result:=true;
  1211. if handle_generic_staticfield_access then
  1212. exit;
  1213. static_name:=lower(generate_nested_name(sym.owner,'_'))+'_'+sym.name;
  1214. if sym.owner.defowner.typ=objectdef then
  1215. searchsym_in_class(tobjectdef(sym.owner.defowner),tobjectdef(sym.owner.defowner),static_name,sym,srsymtable,[ssf_search_helper])
  1216. else
  1217. searchsym_in_record(trecorddef(sym.owner.defowner),static_name,sym,srsymtable);
  1218. if assigned(sym) then
  1219. check_hints(sym,sym.symoptions,sym.deprecatedmsg);
  1220. p1.free;
  1221. p1:=nil;
  1222. { static syms are always stored as absolutevarsym to handle scope and storage properly }
  1223. propaccesslist_to_node(p1,nil,tabsolutevarsym(sym).ref);
  1224. end;
  1225. end;
  1226. function is_bitpacked_access(n: tnode): boolean;
  1227. begin
  1228. case n.nodetype of
  1229. vecn:
  1230. result:=
  1231. is_packed_array(tvecnode(n).left.resultdef) and
  1232. { only orddefs and enumdefs are actually bitpacked. Don't consider
  1233. e.g. an access to a 3-byte record as "bitpacked", since it
  1234. isn't }
  1235. (tvecnode(n).left.resultdef.typ = arraydef) and
  1236. (tarraydef(tvecnode(n).left.resultdef).elementdef.typ in [orddef,enumdef]) and
  1237. not(tarraydef(tvecnode(n).left.resultdef).elepackedbitsize in [8,16,32,64]);
  1238. subscriptn:
  1239. result:=
  1240. is_packed_record_or_object(tsubscriptnode(n).left.resultdef) and
  1241. { see above }
  1242. (tsubscriptnode(n).vs.vardef.typ in [orddef,enumdef]) and
  1243. (not(tsubscriptnode(n).vs.vardef.packedbitsize in [8,16,32,64]) or
  1244. (tsubscriptnode(n).vs.fieldoffset mod 8 <> 0));
  1245. else
  1246. result:=false;
  1247. end;
  1248. end;
  1249. function genloadfield(n: tnode; const fieldname: string): tnode;
  1250. var
  1251. vs : tsym;
  1252. begin
  1253. if not assigned(n.resultdef) then
  1254. typecheckpass(n);
  1255. vs:=tsym(tabstractrecorddef(n.resultdef).symtable.find(fieldname));
  1256. if not assigned(vs) or
  1257. (vs.typ<>fieldvarsym) then
  1258. internalerror(2010061902);
  1259. result:=csubscriptnode.create(vs,n);
  1260. end;
  1261. function has_no_code(n : tnode) : boolean;
  1262. begin
  1263. if n=nil then
  1264. begin
  1265. result:=true;
  1266. exit;
  1267. end;
  1268. case n.nodetype of
  1269. nothingn:
  1270. begin
  1271. result:=true;
  1272. exit;
  1273. end;
  1274. blockn:
  1275. begin
  1276. result:=has_no_code(tblocknode(n).left);
  1277. exit;
  1278. end;
  1279. statementn:
  1280. begin
  1281. repeat
  1282. result:=has_no_code(tstatementnode(n).left);
  1283. n:=tstatementnode(n).right;
  1284. until not(result) or not assigned(n);
  1285. exit;
  1286. end;
  1287. else
  1288. result:=false;
  1289. end;
  1290. end;
  1291. function check_for_sideeffect(var n: tnode; arg: pointer): foreachnoderesult;
  1292. begin
  1293. result:=fen_false;
  1294. if (n.nodetype in [assignn,calln,asmn,finalizetempsn]) or
  1295. ((n.nodetype=inlinen) and
  1296. tinlinenode(n).may_have_sideeffect_norecurse
  1297. ) or
  1298. ((mhs_exceptions in pmhs_flags(arg)^) and
  1299. ((n.nodetype in [derefn,vecn]) or
  1300. ((n.nodetype=subscriptn) and is_implicit_pointer_object_type(tsubscriptnode(n).left.resultdef)) or
  1301. ((n.nodetype in [addn,subn,muln,divn,slashn,unaryminusn]) and (n.localswitches*[cs_check_overflow,cs_check_range]<>[]))
  1302. )
  1303. ) or
  1304. ((n.nodetype=loadn) and
  1305. (
  1306. ((tloadnode(n).symtableentry.typ=absolutevarsym) and (tabsolutevarsym(tloadnode(n).symtableentry).abstyp=toaddr)) or
  1307. ((tloadnode(n).symtableentry.typ in [paravarsym,localvarsym,staticvarsym]) and
  1308. (vo_volatile in tabstractvarsym(tloadnode(n).symtableentry).varoptions)
  1309. )
  1310. )
  1311. ) then
  1312. result:=fen_norecurse_true;
  1313. end;
  1314. function might_have_sideeffects(n : tnode; const flags : tmhs_flags) : boolean;
  1315. begin
  1316. result:=foreachnodestatic(n,@check_for_sideeffect,@flags);
  1317. end;
  1318. function check_for_conditional_nodes(var n: tnode; arg: pointer): foreachnoderesult;
  1319. begin
  1320. result:=fen_false;
  1321. { this check is not complete yet, but sufficent to cover the current use case: swapping
  1322. of trees in expressions }
  1323. if (n.nodetype in [ifn,whilerepeatn,forn,tryexceptn]) or
  1324. ((n.nodetype in [orn,andn]) and is_boolean(n.resultdef) and doshortbooleval(n)) then
  1325. result:=fen_norecurse_true;
  1326. end;
  1327. function has_conditional_nodes(n : tnode) : boolean;
  1328. begin
  1329. result:=foreachnodestatic(n,@check_for_conditional_nodes,nil);
  1330. end;
  1331. var
  1332. nodecount : dword;
  1333. function donodecount(var n: tnode; arg: pointer): foreachnoderesult;
  1334. begin
  1335. inc(nodecount);
  1336. result:=fen_false;
  1337. end;
  1338. function node_count(node : tnode) : dword;
  1339. begin
  1340. nodecount:=0;
  1341. foreachnodestatic(node,@donodecount,nil);
  1342. result:=nodecount;
  1343. end;
  1344. function donodecount_weighted(var n: tnode; arg: pointer): foreachnoderesult;
  1345. begin
  1346. if not(n.nodetype in [blockn,statementn,callparan,nothingn]) then
  1347. inc(nodecount);
  1348. result:=fen_false;
  1349. end;
  1350. function node_count_weighted(node : tnode) : dword;
  1351. begin
  1352. nodecount:=0;
  1353. foreachnodestatic(node,@donodecount_weighted,nil);
  1354. result:=nodecount;
  1355. end;
  1356. function is_const(node : tnode) : boolean;
  1357. begin
  1358. result:=is_constnode(node) or
  1359. ((node.nodetype=temprefn) and (ti_const in ttemprefnode(node).tempflags)) or
  1360. ((node.nodetype=loadn) and (tloadnode(node).symtableentry.typ=paravarsym) and (tparavarsym(tloadnode(node).symtableentry).varspez in [vs_const,vs_constref]));
  1361. end;
  1362. function actualtargetnode(n : pnode) : pnode;
  1363. begin
  1364. result:=n;
  1365. case n^.nodetype of
  1366. typeconvn:
  1367. if ttypeconvnode(n^).retains_value_location then
  1368. result:=actualtargetnode(@ttypeconvnode(n^).left);
  1369. else
  1370. ;
  1371. end;
  1372. end;
  1373. procedure replacenode(var dest,src : tnode);
  1374. var
  1375. t : tnode;
  1376. begin
  1377. t:=src;
  1378. { set src nil before free'ing dest because
  1379. src could be part of dest }
  1380. src:=nil;
  1381. dest.Free;
  1382. dest:=t;
  1383. end;
  1384. function get_open_const_array(p : tnode) : tnode;
  1385. begin
  1386. result:=p;
  1387. if (p.nodetype=derefn) and (tderefnode(p).left.nodetype=addrn) then
  1388. result:=get_open_const_array(taddrnode(tderefnode(result).left).left);
  1389. end;
  1390. function do_node_reset_flags(var n: tnode; arg: pointer): foreachnoderesult;
  1391. begin
  1392. result:=fen_false;
  1393. n.flags:=n.flags-tnodeflags(arg^);
  1394. end;
  1395. procedure node_reset_flags(p : tnode; nf : tnodeflags);
  1396. begin
  1397. foreachnodestatic(p,@do_node_reset_flags,@nf);
  1398. end;
  1399. type
  1400. tlocalswitchchange = record
  1401. cs : tlocalswitch;
  1402. enable : boolean;
  1403. end;
  1404. plocalswitchchange = ^tlocalswitchchange;
  1405. function do_change_local_settings(var p : tnode;plsc : pointer) : foreachnoderesult;
  1406. begin
  1407. if plocalswitchchange(plsc)^.enable then
  1408. include(p.localswitches, plocalswitchchange(plsc)^.cs)
  1409. else
  1410. exclude(p.localswitches, plocalswitchchange(plsc)^.cs);
  1411. result:=fen_true;
  1412. end;
  1413. procedure node_change_local_switch(p : tnode;cs : tlocalswitch;enable : boolean);
  1414. var
  1415. lsc : tlocalswitchchange;
  1416. begin
  1417. lsc.cs:=cs;
  1418. lsc.enable:=enable;
  1419. foreachnodestatic(p,@do_change_local_settings,@lsc);
  1420. end;
  1421. function doshortbooleval(p : tnode) : Boolean;
  1422. begin
  1423. Result:=(p.nodetype in [orn,andn]) and ((nf_short_bool in taddnode(p).flags) or not(cs_full_boolean_eval in p.localswitches));
  1424. end;
  1425. function is_constintvalue(p: tnode; l: Tconstexprint): Boolean;
  1426. begin
  1427. Result:=is_constintnode(p) and (tordconstnode(p).value=l);
  1428. end;
  1429. function is_inlinefunction(p: tnode; i: tinlinenumber): Boolean;
  1430. begin
  1431. Result:=(p.nodetype=inlinen) and (tinlinenode(p).inlinenumber=i);
  1432. end;
  1433. function MatchAndTransformNodesCommutative(n1,n2 : tnode;matchproc : TMatchProc2;transformproc : TTransformProc2;var res : tnode) : Boolean;
  1434. begin
  1435. res:=nil;
  1436. result:=true;
  1437. if matchproc(n1,n2) then
  1438. res:=transformproc(n1,n2)
  1439. else if matchproc(n2,n1) then
  1440. res:=transformproc(n2,n1)
  1441. else
  1442. result:=false;
  1443. end;
  1444. end.