nutils.pas 36 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088
  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. interface
  20. uses
  21. globtype,
  22. symtype,symsym,symbase,symtable,
  23. node;
  24. const
  25. NODE_COMPLEXITY_INF = 255;
  26. type
  27. { resultdef of functions that process on all nodes in a (sub)tree }
  28. foreachnoderesult = (
  29. { false, continue recursion }
  30. fen_false,
  31. { false, stop recursion }
  32. fen_norecurse_false,
  33. { true, continue recursion }
  34. fen_true,
  35. { true, stop recursion }
  36. fen_norecurse_true
  37. );
  38. tforeachprocmethod = (pm_preprocess,pm_postprocess);
  39. foreachnodefunction = function(var n: tnode; arg: pointer): foreachnoderesult of object;
  40. staticforeachnodefunction = function(var n: tnode; arg: pointer): foreachnoderesult;
  41. function foreachnode(var n: tnode; f: foreachnodefunction; arg: pointer): boolean;
  42. function foreachnode(procmethod : tforeachprocmethod; var n: tnode; f: foreachnodefunction; arg: pointer): boolean;
  43. function foreachnodestatic(var n: tnode; f: staticforeachnodefunction; arg: pointer): boolean;
  44. function foreachnodestatic(procmethod : tforeachprocmethod; var n: tnode; f: staticforeachnodefunction; arg: pointer): boolean;
  45. { checks if the given node tree contains only nodes of the given type,
  46. if this isn't the case, an ie is thrown
  47. }
  48. procedure checktreenodetypes(n : tnode;typeset : tnodetypeset);
  49. procedure load_procvar_from_calln(var p1:tnode);
  50. function maybe_call_procvar(var p1:tnode;tponly:boolean):boolean;
  51. function get_high_value_sym(vs: tparavarsym):tsym; { marking it as inline causes IE 200311075 during loading from ppu file }
  52. function load_high_value_node(vs:tparavarsym):tnode;
  53. function load_self_node:tnode;
  54. function load_result_node:tnode;
  55. function load_self_pointer_node:tnode;
  56. function load_vmt_pointer_node:tnode;
  57. function is_self_node(p:tnode):boolean;
  58. function call_fail_node:tnode;
  59. function initialize_data_node(p:tnode):tnode;
  60. function finalize_data_node(p:tnode):tnode;
  61. function node_complexity(p: tnode): cardinal;
  62. function node_resources_fpu(p: tnode): cardinal;
  63. procedure node_tree_set_filepos(var n:tnode;const filepos:tfileposinfo);
  64. { tries to simplify the given node }
  65. procedure dosimplify(var n : tnode);
  66. { returns true if n is only a tree of administrative nodes
  67. containing no code }
  68. function has_no_code(n : tnode) : boolean;
  69. function getpropaccesslist(propsym:tpropertysym; pap:tpropaccesslisttypes;out propaccesslist:tpropaccesslist):boolean;
  70. procedure propaccesslist_to_node(var p1:tnode;st:TSymtable;pl:tpropaccesslist);
  71. function node_to_propaccesslist(p1:tnode):tpropaccesslist;
  72. implementation
  73. uses
  74. cutils,verbose,constexp,globals,
  75. symconst,symdef,
  76. defutil,defcmp,
  77. nbas,ncon,ncnv,nld,nflw,nset,ncal,nadd,nmem,ninl,
  78. cpubase,cgbase,procinfo,
  79. pass_1;
  80. function foreachnode(procmethod : tforeachprocmethod;var n: tnode; f: foreachnodefunction; arg: pointer): boolean;
  81. function process_children(res : boolean) : boolean;
  82. var
  83. i: longint;
  84. begin
  85. result:=res;
  86. case n.nodetype of
  87. asn:
  88. if assigned(tasnode(n).call) then
  89. begin
  90. result := foreachnode(procmethod,tasnode(n).call,f,arg);
  91. exit
  92. end;
  93. calln:
  94. begin
  95. result := foreachnode(procmethod,tnode(tcallnode(n).callinitblock),f,arg) or result;
  96. result := foreachnode(procmethod,tcallnode(n).methodpointer,f,arg) or result;
  97. result := foreachnode(procmethod,tcallnode(n).funcretnode,f,arg) or result;
  98. result := foreachnode(procmethod,tnode(tcallnode(n).callcleanupblock),f,arg) or result;
  99. end;
  100. ifn, whilerepeatn, forn, tryexceptn, tryfinallyn:
  101. begin
  102. { not in one statement, won't work because of b- }
  103. result := foreachnode(procmethod,tloopnode(n).t1,f,arg) or result;
  104. result := foreachnode(procmethod,tloopnode(n).t2,f,arg) or result;
  105. end;
  106. raisen:
  107. { frame tree }
  108. result := foreachnode(traisenode(n).third,f,arg) or result;
  109. casen:
  110. begin
  111. for i := 0 to tcasenode(n).blocks.count-1 do
  112. if assigned(tcasenode(n).blocks[i]) then
  113. result := foreachnode(procmethod,pcaseblock(tcasenode(n).blocks[i])^.statement,f,arg) or result;
  114. result := foreachnode(procmethod,tcasenode(n).elseblock,f,arg) or result;
  115. end;
  116. end;
  117. if n.inheritsfrom(tbinarynode) then
  118. begin
  119. { first process the "payload" of statementnodes }
  120. result := foreachnode(procmethod,tbinarynode(n).left,f,arg) or result;
  121. result := foreachnode(procmethod,tbinarynode(n).right,f,arg) or result;
  122. end
  123. else if n.inheritsfrom(tunarynode) then
  124. result := foreachnode(procmethod,tunarynode(n).left,f,arg) or result;
  125. end;
  126. begin
  127. result := false;
  128. if not assigned(n) then
  129. exit;
  130. if procmethod=pm_preprocess then
  131. result:=process_children(result);
  132. case f(n,arg) of
  133. fen_norecurse_false:
  134. exit;
  135. fen_norecurse_true:
  136. begin
  137. result := true;
  138. exit;
  139. end;
  140. fen_true:
  141. result := true;
  142. { result is already false
  143. fen_false:
  144. result := false; }
  145. end;
  146. if procmethod=pm_postprocess then
  147. result:=process_children(result);
  148. end;
  149. function foreachnode(var n: tnode; f: foreachnodefunction; arg: pointer): boolean;
  150. begin
  151. result:=foreachnode(pm_postprocess,n,f,arg);
  152. end;
  153. function foreachnodestatic(procmethod : tforeachprocmethod;var n: tnode; f: staticforeachnodefunction; 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 := foreachnodestatic(procmethod,tasnode(n).call,f,arg);
  164. exit
  165. end;
  166. calln:
  167. begin
  168. result := foreachnodestatic(procmethod,tnode(tcallnode(n).callinitblock),f,arg) or result;
  169. result := foreachnodestatic(procmethod,tcallnode(n).methodpointer,f,arg) or result;
  170. result := foreachnodestatic(procmethod,tcallnode(n).funcretnode,f,arg) or result;
  171. result := foreachnodestatic(procmethod,tnode(tcallnode(n).callcleanupblock),f,arg) or result;
  172. end;
  173. ifn, whilerepeatn, forn, tryexceptn, tryfinallyn:
  174. begin
  175. { not in one statement, won't work because of b- }
  176. result := foreachnodestatic(procmethod,tloopnode(n).t1,f,arg) or result;
  177. result := foreachnodestatic(procmethod,tloopnode(n).t2,f,arg) or result;
  178. end;
  179. raisen:
  180. { frame tree }
  181. result := foreachnodestatic(traisenode(n).third,f,arg) or result;
  182. casen:
  183. begin
  184. for i := 0 to tcasenode(n).blocks.count-1 do
  185. if assigned(tcasenode(n).blocks[i]) then
  186. result := foreachnodestatic(procmethod,pcaseblock(tcasenode(n).blocks[i])^.statement,f,arg) or result;
  187. result := foreachnodestatic(procmethod,tcasenode(n).elseblock,f,arg) or result;
  188. end;
  189. end;
  190. if n.inheritsfrom(tbinarynode) then
  191. begin
  192. { first process the "payload" of statementnodes }
  193. result := foreachnodestatic(procmethod,tbinarynode(n).left,f,arg) or result;
  194. result := foreachnodestatic(procmethod,tbinarynode(n).right,f,arg) or result;
  195. end
  196. else if n.inheritsfrom(tunarynode) then
  197. result := foreachnodestatic(procmethod,tunarynode(n).left,f,arg) or result;
  198. end;
  199. begin
  200. result := false;
  201. if not assigned(n) then
  202. exit;
  203. if procmethod=pm_preprocess then
  204. result:=process_children(result);
  205. case f(n,arg) of
  206. fen_norecurse_false:
  207. exit;
  208. fen_norecurse_true:
  209. begin
  210. result := true;
  211. exit;
  212. end;
  213. fen_true:
  214. result := true;
  215. { result is already false
  216. fen_false:
  217. result := false; }
  218. end;
  219. if procmethod=pm_postprocess then
  220. result:=process_children(result);
  221. end;
  222. function foreachnodestatic(var n: tnode; f: staticforeachnodefunction; arg: pointer): boolean;
  223. begin
  224. result:=foreachnodestatic(pm_postprocess,n,f,arg);
  225. end;
  226. function do_check(var n: tnode; arg: pointer): foreachnoderesult;
  227. begin
  228. if not(n.nodetype in pnodetypeset(arg)^) then
  229. internalerror(200610141);
  230. result:=fen_true;
  231. end;
  232. procedure checktreenodetypes(n : tnode;typeset : tnodetypeset);
  233. begin
  234. foreachnodestatic(n,@do_check,@typeset);
  235. end;
  236. procedure load_procvar_from_calln(var p1:tnode);
  237. var
  238. p2 : tnode;
  239. begin
  240. if p1.nodetype<>calln then
  241. internalerror(200212251);
  242. { was it a procvar, then we simply remove the calln and
  243. reuse the right }
  244. if assigned(tcallnode(p1).right) then
  245. begin
  246. p2:=tcallnode(p1).right;
  247. tcallnode(p1).right:=nil;
  248. end
  249. else
  250. begin
  251. p2:=cloadnode.create_procvar(tcallnode(p1).symtableprocentry,
  252. tprocdef(tcallnode(p1).procdefinition),tcallnode(p1).symtableproc);
  253. { when the methodpointer is typen we've something like:
  254. tobject.create. Then only the address is needed of the
  255. method without a self pointer }
  256. if assigned(tcallnode(p1).methodpointer) and
  257. (tcallnode(p1).methodpointer.nodetype<>typen) then
  258. tloadnode(p2).set_mp(tcallnode(p1).methodpointer.getcopy);
  259. end;
  260. typecheckpass(p2);
  261. p1.free;
  262. p1:=p2;
  263. end;
  264. function maybe_call_procvar(var p1:tnode;tponly:boolean):boolean;
  265. var
  266. hp : tnode;
  267. begin
  268. result:=false;
  269. if (p1.resultdef.typ<>procvardef) or
  270. (tponly and
  271. not(m_tp_procvar in current_settings.modeswitches)) then
  272. exit;
  273. { ignore vecn,subscriptn }
  274. hp:=p1;
  275. repeat
  276. case hp.nodetype of
  277. vecn,
  278. derefn,
  279. typeconvn,
  280. subscriptn :
  281. hp:=tunarynode(hp).left;
  282. else
  283. break;
  284. end;
  285. until false;
  286. { a tempref is used when it is loaded from a withsymtable }
  287. if (hp.nodetype in [calln,loadn,temprefn]) then
  288. begin
  289. hp:=ccallnode.create_procvar(nil,p1);
  290. typecheckpass(hp);
  291. p1:=hp;
  292. result:=true;
  293. end;
  294. end;
  295. function get_high_value_sym(vs: tparavarsym):tsym;
  296. begin
  297. result := tsym(vs.owner.Find('high'+vs.name));
  298. end;
  299. function get_local_or_para_sym(const aname:string):tsym;
  300. var
  301. pd : tprocdef;
  302. begin
  303. result:=nil;
  304. { is not assigned while parsing a property }
  305. if not assigned(current_procinfo) then
  306. exit;
  307. { we can't use searchsym here, because the
  308. symtablestack is not fully setup when pass1
  309. is run for nested procedures }
  310. pd:=current_procinfo.procdef;
  311. repeat
  312. result := tsym(pd.localst.Find(aname));
  313. if assigned(result) then
  314. break;
  315. result := tsym(pd.parast.Find(aname));
  316. if assigned(result) then
  317. break;
  318. { try the parent of a nested function }
  319. if assigned(pd.owner.defowner) and
  320. (pd.owner.defowner.typ=procdef) then
  321. pd:=tprocdef(pd.owner.defowner)
  322. else
  323. break;
  324. until false;
  325. end;
  326. function load_high_value_node(vs:tparavarsym):tnode;
  327. var
  328. srsym : tsym;
  329. begin
  330. result:=nil;
  331. srsym:=get_high_value_sym(vs);
  332. if assigned(srsym) then
  333. begin
  334. result:=cloadnode.create(srsym,vs.owner);
  335. typecheckpass(result);
  336. end
  337. else
  338. CGMessage(parser_e_illegal_expression);
  339. end;
  340. function load_self_node:tnode;
  341. var
  342. srsym : tsym;
  343. begin
  344. result:=nil;
  345. srsym:=get_local_or_para_sym('self');
  346. if assigned(srsym) then
  347. begin
  348. result:=cloadnode.create(srsym,srsym.owner);
  349. include(result.flags,nf_is_self);
  350. end
  351. else
  352. begin
  353. result:=cerrornode.create;
  354. CGMessage(parser_e_illegal_expression);
  355. end;
  356. typecheckpass(result);
  357. end;
  358. function load_result_node:tnode;
  359. var
  360. srsym : tsym;
  361. begin
  362. result:=nil;
  363. srsym:=get_local_or_para_sym('result');
  364. if assigned(srsym) then
  365. result:=cloadnode.create(srsym,srsym.owner)
  366. else
  367. begin
  368. result:=cerrornode.create;
  369. CGMessage(parser_e_illegal_expression);
  370. end;
  371. typecheckpass(result);
  372. end;
  373. function load_self_pointer_node:tnode;
  374. var
  375. srsym : tsym;
  376. begin
  377. result:=nil;
  378. srsym:=get_local_or_para_sym('self');
  379. if assigned(srsym) then
  380. begin
  381. result:=cloadnode.create(srsym,srsym.owner);
  382. include(result.flags,nf_load_self_pointer);
  383. end
  384. else
  385. begin
  386. result:=cerrornode.create;
  387. CGMessage(parser_e_illegal_expression);
  388. end;
  389. typecheckpass(result);
  390. end;
  391. function load_vmt_pointer_node:tnode;
  392. var
  393. srsym : tsym;
  394. begin
  395. result:=nil;
  396. srsym:=get_local_or_para_sym('vmt');
  397. if assigned(srsym) then
  398. result:=cloadnode.create(srsym,srsym.owner)
  399. else
  400. begin
  401. result:=cerrornode.create;
  402. CGMessage(parser_e_illegal_expression);
  403. end;
  404. typecheckpass(result);
  405. end;
  406. function is_self_node(p:tnode):boolean;
  407. begin
  408. is_self_node:=(p.nodetype=loadn) and
  409. (tloadnode(p).symtableentry.typ=paravarsym) and
  410. (vo_is_self in tparavarsym(tloadnode(p).symtableentry).varoptions);
  411. end;
  412. function call_fail_node:tnode;
  413. var
  414. para : tcallparanode;
  415. newstatement : tstatementnode;
  416. srsym : tsym;
  417. begin
  418. result:=internalstatements(newstatement);
  419. { call fail helper and exit normal }
  420. if is_class(current_objectdef) then
  421. begin
  422. srsym:=search_class_member(current_objectdef,'FREEINSTANCE');
  423. if assigned(srsym) and
  424. (srsym.typ=procsym) then
  425. begin
  426. { if self<>0 and vmt<>0 then freeinstance }
  427. addstatement(newstatement,cifnode.create(
  428. caddnode.create(andn,
  429. caddnode.create(unequaln,
  430. load_self_pointer_node,
  431. cnilnode.create),
  432. caddnode.create(unequaln,
  433. load_vmt_pointer_node,
  434. cnilnode.create)),
  435. ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_self_node,[]),
  436. nil));
  437. end
  438. else
  439. internalerror(200305108);
  440. end
  441. else
  442. if is_object(current_objectdef) then
  443. begin
  444. { parameter 3 : vmt_offset }
  445. { parameter 2 : pointer to vmt }
  446. { parameter 1 : self pointer }
  447. para:=ccallparanode.create(
  448. cordconstnode.create(current_objectdef.vmt_offset,s32inttype,false),
  449. ccallparanode.create(
  450. ctypeconvnode.create_internal(
  451. load_vmt_pointer_node,
  452. voidpointertype),
  453. ccallparanode.create(
  454. ctypeconvnode.create_internal(
  455. load_self_pointer_node,
  456. voidpointertype),
  457. nil)));
  458. addstatement(newstatement,
  459. ccallnode.createintern('fpc_help_fail',para));
  460. end
  461. else
  462. internalerror(200305132);
  463. { self:=nil }
  464. addstatement(newstatement,cassignmentnode.create(
  465. load_self_pointer_node,
  466. cnilnode.create));
  467. { exit }
  468. addstatement(newstatement,cexitnode.create(nil));
  469. end;
  470. function initialize_data_node(p:tnode):tnode;
  471. begin
  472. if not assigned(p.resultdef) then
  473. typecheckpass(p);
  474. if is_ansistring(p.resultdef) or
  475. is_wide_or_unicode_string(p.resultdef) or
  476. is_interfacecom(p.resultdef) or
  477. is_dynamic_array(p.resultdef) then
  478. begin
  479. result:=cassignmentnode.create(
  480. ctypeconvnode.create_internal(p,voidpointertype),
  481. cnilnode.create
  482. );
  483. end
  484. else
  485. begin
  486. result:=ccallnode.createintern('fpc_initialize',
  487. ccallparanode.create(
  488. caddrnode.create_internal(
  489. crttinode.create(
  490. tstoreddef(p.resultdef),initrtti,rdt_normal)),
  491. ccallparanode.create(
  492. caddrnode.create_internal(p),
  493. nil)));
  494. end;
  495. end;
  496. function finalize_data_node(p:tnode):tnode;
  497. var
  498. newstatement : tstatementnode;
  499. begin
  500. if not assigned(p.resultdef) then
  501. typecheckpass(p);
  502. if is_ansistring(p.resultdef) then
  503. begin
  504. result:=internalstatements(newstatement);
  505. addstatement(newstatement,ccallnode.createintern('fpc_ansistr_decr_ref',
  506. ccallparanode.create(
  507. ctypeconvnode.create_internal(p,voidpointertype),
  508. nil)));
  509. addstatement(newstatement,cassignmentnode.create(
  510. ctypeconvnode.create_internal(p.getcopy,voidpointertype),
  511. cnilnode.create
  512. ));
  513. end
  514. else if is_widestring(p.resultdef) then
  515. begin
  516. result:=internalstatements(newstatement);
  517. addstatement(newstatement,ccallnode.createintern('fpc_widestr_decr_ref',
  518. ccallparanode.create(
  519. ctypeconvnode.create_internal(p,voidpointertype),
  520. nil)));
  521. addstatement(newstatement,cassignmentnode.create(
  522. ctypeconvnode.create_internal(p.getcopy,voidpointertype),
  523. cnilnode.create
  524. ));
  525. end
  526. else if is_unicodestring(p.resultdef) then
  527. begin
  528. result:=internalstatements(newstatement);
  529. addstatement(newstatement,ccallnode.createintern('fpc_unicodestr_decr_ref',
  530. ccallparanode.create(
  531. ctypeconvnode.create_internal(p,voidpointertype),
  532. nil)));
  533. addstatement(newstatement,cassignmentnode.create(
  534. ctypeconvnode.create_internal(p.getcopy,voidpointertype),
  535. cnilnode.create
  536. ));
  537. end
  538. else if is_interfacecom(p.resultdef) then
  539. begin
  540. result:=internalstatements(newstatement);
  541. addstatement(newstatement,ccallnode.createintern('fpc_intf_decr_ref',
  542. ccallparanode.create(
  543. ctypeconvnode.create_internal(p,voidpointertype),
  544. nil)));
  545. addstatement(newstatement,cassignmentnode.create(
  546. ctypeconvnode.create_internal(p.getcopy,voidpointertype),
  547. cnilnode.create
  548. ));
  549. end
  550. else
  551. result:=ccallnode.createintern('fpc_finalize',
  552. ccallparanode.create(
  553. caddrnode.create_internal(
  554. crttinode.create(
  555. tstoreddef(p.resultdef),initrtti,rdt_normal)),
  556. ccallparanode.create(
  557. caddrnode.create_internal(p),
  558. nil)));
  559. end;
  560. { this function must return a very high value ("infinity") for }
  561. { trees containing a call, the rest can be balanced more or less }
  562. { at will, probably best mainly in terms of required memory }
  563. { accesses }
  564. function node_complexity(p: tnode): cardinal;
  565. var
  566. correction: byte;
  567. {$ifdef ARM}
  568. dummy : byte;
  569. {$endif ARM}
  570. begin
  571. result := 0;
  572. while assigned(p) do
  573. begin
  574. case p.nodetype of
  575. { floating point constants usually need loading from memory }
  576. realconstn,
  577. temprefn,
  578. loadvmtaddrn,
  579. { main reason for the next one: we can't take the address of }
  580. { loadparentfpnode, so replacing it by a temp which is the }
  581. { address of this node's location and then dereferencing }
  582. { doesn't work. If changed, check whether webtbs/tw0935 }
  583. { still works with nodeinlining (JM) }
  584. loadparentfpn:
  585. begin
  586. result := 1;
  587. exit;
  588. end;
  589. loadn:
  590. begin
  591. { threadvars need a helper call }
  592. if (tloadnode(p).symtableentry.typ=staticvarsym) and
  593. (vo_is_thread_var in tstaticvarsym(tloadnode(p).symtableentry).varoptions) then
  594. inc(result,5)
  595. else
  596. inc(result);
  597. if (result >= NODE_COMPLEXITY_INF) then
  598. result := NODE_COMPLEXITY_INF;
  599. exit;
  600. end;
  601. subscriptn:
  602. begin
  603. if is_class_or_interface_or_objc(tunarynode(p).left.resultdef) then
  604. inc(result,2);
  605. if (result = NODE_COMPLEXITY_INF) then
  606. exit;
  607. p := tunarynode(p).left;
  608. end;
  609. blockn,
  610. callparan:
  611. p := tunarynode(p).left;
  612. notn,
  613. derefn :
  614. begin
  615. inc(result);
  616. if (result = NODE_COMPLEXITY_INF) then
  617. exit;
  618. p := tunarynode(p).left;
  619. end;
  620. typeconvn:
  621. begin
  622. { may be more complex in some cases }
  623. if not(ttypeconvnode(p).convtype in [tc_equal,tc_int_2_int,tc_bool_2_bool,tc_real_2_real,tc_cord_2_pointer]) then
  624. inc(result);
  625. if (result = NODE_COMPLEXITY_INF) then
  626. exit;
  627. p := tunarynode(p).left;
  628. end;
  629. vecn,
  630. statementn:
  631. begin
  632. inc(result,node_complexity(tbinarynode(p).left));
  633. if (result >= NODE_COMPLEXITY_INF) then
  634. begin
  635. result := NODE_COMPLEXITY_INF;
  636. exit;
  637. end;
  638. p := tbinarynode(p).right;
  639. end;
  640. addn,subn,orn,andn,xorn,muln,divn,modn,symdifn,
  641. shln,shrn,
  642. equaln,unequaln,gtn,gten,ltn,lten,
  643. assignn:
  644. begin
  645. {$ifdef CPU64BITALU}
  646. correction:=1;
  647. {$else CPU64BITALU}
  648. correction:=2;
  649. {$endif CPU64BITALU}
  650. inc(result,node_complexity(tbinarynode(p).left)+1*correction);
  651. if (p.nodetype in [muln,divn,modn]) then
  652. inc(result,5*correction*correction);
  653. if (result >= NODE_COMPLEXITY_INF) then
  654. begin
  655. result := NODE_COMPLEXITY_INF;
  656. exit;
  657. end;
  658. p := tbinarynode(p).right;
  659. end;
  660. ordconstn:
  661. begin
  662. {$ifdef ARM}
  663. if not(is_shifter_const(tordconstnode(p).value.svalue,dummy)) then
  664. result:=2;
  665. {$endif ARM}
  666. exit;
  667. end;
  668. stringconstn,
  669. tempcreaten,
  670. tempdeleten,
  671. pointerconstn,
  672. nothingn,
  673. niln:
  674. exit;
  675. inlinen:
  676. begin
  677. { this code assumes that the inline node has }
  678. { already been firstpassed, and consequently }
  679. { that inline nodes which are transformed into }
  680. { calls already have been transformed }
  681. case tinlinenode(p).inlinenumber of
  682. in_lo_qword,
  683. in_hi_qword,
  684. in_lo_long,
  685. in_hi_long,
  686. in_lo_word,
  687. in_hi_word,
  688. in_length_x,
  689. in_assigned_x,
  690. in_pred_x,
  691. in_succ_x,
  692. in_round_real,
  693. in_trunc_real,
  694. in_int_real,
  695. in_frac_real,
  696. in_cos_real,
  697. in_sin_real,
  698. in_arctan_real,
  699. in_pi_real,
  700. in_abs_real,
  701. in_sqr_real,
  702. in_sqrt_real,
  703. in_ln_real,
  704. in_unaligned_x,
  705. in_prefetch_var:
  706. begin
  707. inc(result);
  708. p:=tunarynode(p).left;
  709. end;
  710. in_abs_long:
  711. begin
  712. inc(result,3);
  713. if (result >= NODE_COMPLEXITY_INF) then
  714. begin
  715. result:=NODE_COMPLEXITY_INF;
  716. exit;
  717. end;
  718. p:=tunarynode(p).left;
  719. end;
  720. in_sizeof_x,
  721. in_typeof_x:
  722. begin
  723. inc(result);
  724. if (tinlinenode(p).left.nodetype<>typen) then
  725. { get instance vmt }
  726. p:=tunarynode(p).left
  727. else
  728. { type vmt = global symbol, result is }
  729. { already increased above }
  730. exit;
  731. end;
  732. {$ifdef SUPPORT_MMX}
  733. in_mmx_pcmpeqb..in_mmx_pcmpgtw,
  734. {$endif SUPPORT_MMX}
  735. { load from global symbol }
  736. in_typeinfo_x,
  737. { load frame pointer }
  738. in_get_frame,
  739. in_get_caller_frame,
  740. in_get_caller_addr:
  741. begin
  742. inc(result);
  743. exit;
  744. end;
  745. in_inc_x,
  746. in_dec_x,
  747. in_include_x_y,
  748. in_exclude_x_y,
  749. in_assert_x_y :
  750. begin
  751. { operation (add, sub, or, and }
  752. inc(result);
  753. { left expression }
  754. inc(result,node_complexity(tcallparanode(tunarynode(p).left).left));
  755. if (result >= NODE_COMPLEXITY_INF) then
  756. begin
  757. result := NODE_COMPLEXITY_INF;
  758. exit;
  759. end;
  760. p:=tcallparanode(tunarynode(p).left).right;
  761. if assigned(p) then
  762. p:=tcallparanode(p).left;
  763. end;
  764. else
  765. begin
  766. result := NODE_COMPLEXITY_INF;
  767. exit;
  768. end;
  769. end;
  770. end;
  771. else
  772. begin
  773. result := NODE_COMPLEXITY_INF;
  774. exit;
  775. end;
  776. end;
  777. end;
  778. end;
  779. { this function returns an indication how much fpu registers
  780. will be required.
  781. Note: The algorithms need to be pessimistic to prevent a
  782. fpu stack overflow on i386 }
  783. function node_resources_fpu(p: tnode): cardinal;
  784. var
  785. res1,res2,res3 : cardinal;
  786. begin
  787. result:=0;
  788. res1:=0;
  789. res2:=0;
  790. res3:=0;
  791. if p.inheritsfrom(tunarynode) then
  792. begin
  793. if assigned(tunarynode(p).left) then
  794. res1:=node_resources_fpu(tunarynode(p).left);
  795. if p.inheritsfrom(tbinarynode) then
  796. begin
  797. if assigned(tbinarynode(p).right) then
  798. res2:=node_resources_fpu(tbinarynode(p).right);
  799. if p.inheritsfrom(ttertiarynode) and assigned(ttertiarynode(p).third) then
  800. res3:=node_resources_fpu(ttertiarynode(p).third)
  801. end;
  802. end;
  803. result:=max(max(res1,res2),res3);
  804. case p.nodetype of
  805. calln:
  806. { it could be a recursive call, so we never really know the number of used fpu registers }
  807. result:=maxfpuregs;
  808. realconstn,
  809. typeconvn,
  810. loadn :
  811. begin
  812. if p.expectloc in [LOC_CFPUREGISTER,LOC_FPUREGISTER] then
  813. result:=max(result,1);
  814. end;
  815. assignn,
  816. addn,subn,muln,slashn,
  817. equaln,unequaln,gtn,gten,ltn,lten :
  818. begin
  819. if (tbinarynode(p).left.expectloc in [LOC_CFPUREGISTER,LOC_FPUREGISTER]) or
  820. (tbinarynode(p).right.expectloc in [LOC_CFPUREGISTER,LOC_FPUREGISTER])then
  821. result:=max(result,2);
  822. if(p.expectloc in [LOC_CFPUREGISTER,LOC_FPUREGISTER]) then
  823. inc(result);
  824. end;
  825. end;
  826. end;
  827. function setnodefilepos(var n: tnode; arg: pointer): foreachnoderesult;
  828. begin
  829. result:=fen_true;
  830. n.fileinfo:=pfileposinfo(arg)^;
  831. end;
  832. procedure node_tree_set_filepos(var n:tnode;const filepos:tfileposinfo);
  833. begin
  834. foreachnodestatic(n,@setnodefilepos,@filepos);
  835. end;
  836. {$ifdef FPCMT}
  837. threadvar
  838. {$else FPCMT}
  839. var
  840. {$endif FPCMT}
  841. treechanged : boolean;
  842. function callsimplify(var n: tnode; arg: pointer): foreachnoderesult;
  843. var
  844. hn : tnode;
  845. begin
  846. result:=fen_false;
  847. // do_typecheckpass(n);
  848. hn:=n.simplify;
  849. if assigned(hn) then
  850. begin
  851. treechanged:=true;
  852. n.free;
  853. n:=hn;
  854. typecheckpass(n);
  855. end;
  856. end;
  857. { tries to simplify the given node calling the simplify method recursively }
  858. procedure dosimplify(var n : tnode);
  859. begin
  860. repeat
  861. treechanged:=false;
  862. foreachnodestatic(pm_preprocess,n,@callsimplify,nil);
  863. until not(treechanged);
  864. end;
  865. function getpropaccesslist(propsym:tpropertysym; pap:tpropaccesslisttypes;out propaccesslist:tpropaccesslist):boolean;
  866. var
  867. hpropsym : tpropertysym;
  868. begin
  869. result:=false;
  870. { find property in the overriden list }
  871. hpropsym:=propsym;
  872. repeat
  873. propaccesslist:=hpropsym.propaccesslist[pap];
  874. if not propaccesslist.empty then
  875. begin
  876. result:=true;
  877. exit;
  878. end;
  879. hpropsym:=hpropsym.overridenpropsym;
  880. until not assigned(hpropsym);
  881. end;
  882. procedure propaccesslist_to_node(var p1:tnode;st:TSymtable;pl:tpropaccesslist);
  883. var
  884. plist : ppropaccesslistitem;
  885. begin
  886. plist:=pl.firstsym;
  887. while assigned(plist) do
  888. begin
  889. case plist^.sltype of
  890. sl_load :
  891. begin
  892. addsymref(plist^.sym);
  893. if not assigned(st) then
  894. st:=plist^.sym.owner;
  895. { p1 can already contain the loadnode of
  896. the class variable. When there is no tree yet we
  897. may need to load it for with or objects }
  898. if not assigned(p1) then
  899. begin
  900. case st.symtabletype of
  901. withsymtable :
  902. p1:=tnode(twithsymtable(st).withrefnode).getcopy;
  903. ObjectSymtable :
  904. p1:=load_self_node;
  905. end;
  906. end;
  907. if assigned(p1) then
  908. p1:=csubscriptnode.create(plist^.sym,p1)
  909. else
  910. p1:=cloadnode.create(plist^.sym,st);
  911. end;
  912. sl_subscript :
  913. begin
  914. addsymref(plist^.sym);
  915. p1:=csubscriptnode.create(plist^.sym,p1);
  916. end;
  917. sl_typeconv :
  918. p1:=ctypeconvnode.create_explicit(p1,plist^.def);
  919. sl_absolutetype :
  920. begin
  921. p1:=ctypeconvnode.create(p1,plist^.def);
  922. include(p1.flags,nf_absolute);
  923. end;
  924. sl_vec :
  925. p1:=cvecnode.create(p1,cordconstnode.create(plist^.value,plist^.valuedef,true));
  926. else
  927. internalerror(200110205);
  928. end;
  929. plist:=plist^.next;
  930. end;
  931. end;
  932. function node_to_propaccesslist(p1:tnode):tpropaccesslist;
  933. var
  934. sl : tpropaccesslist;
  935. procedure addnode(p:tnode);
  936. begin
  937. case p.nodetype of
  938. subscriptn :
  939. begin
  940. addnode(tsubscriptnode(p).left);
  941. sl.addsym(sl_subscript,tsubscriptnode(p).vs);
  942. end;
  943. typeconvn :
  944. begin
  945. addnode(ttypeconvnode(p).left);
  946. if nf_absolute in ttypeconvnode(p).flags then
  947. sl.addtype(sl_absolutetype,ttypeconvnode(p).totypedef)
  948. else
  949. sl.addtype(sl_typeconv,ttypeconvnode(p).totypedef);
  950. end;
  951. vecn :
  952. begin
  953. addnode(tvecnode(p).left);
  954. if tvecnode(p).right.nodetype=ordconstn then
  955. sl.addconst(sl_vec,tordconstnode(tvecnode(p).right).value,tvecnode(p).right.resultdef)
  956. else
  957. begin
  958. Message(parser_e_illegal_expression);
  959. { recovery }
  960. sl.addconst(sl_vec,0,tvecnode(p).right.resultdef);
  961. end;
  962. end;
  963. loadn :
  964. sl.addsym(sl_load,tloadnode(p).symtableentry);
  965. else
  966. internalerror(200310282);
  967. end;
  968. end;
  969. begin
  970. sl:=tpropaccesslist.create;
  971. addnode(p1);
  972. result:=sl;
  973. end;
  974. function has_no_code(n : tnode) : boolean;
  975. begin
  976. if n=nil then
  977. begin
  978. result:=true;
  979. exit;
  980. end;
  981. result:=false;
  982. case n.nodetype of
  983. nothingn:
  984. begin
  985. result:=true;
  986. exit;
  987. end;
  988. blockn:
  989. begin
  990. result:=has_no_code(tblocknode(n).left);
  991. exit;
  992. end;
  993. end;
  994. end;
  995. end.