nutils.pas 58 KB

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