nld.pas 56 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637
  1. {
  2. $Id$
  3. Copyright (c) 2000-2002 by Florian Klaempfl
  4. Type checking and register allocation for load/assignment nodes
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit nld;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. node,
  23. {$ifdef state_tracking}
  24. nstate,
  25. {$endif}
  26. symconst,symbase,symtype,symsym,symdef;
  27. type
  28. tloadnode = class(tunarynode)
  29. symtableentry : tsym;
  30. symtableentryderef : tderef;
  31. symtable : tsymtable;
  32. procdef : tprocdef;
  33. procdefderef : tderef;
  34. constructor create(v : tsym;st : tsymtable);virtual;
  35. constructor create_procvar(v : tsym;d:tprocdef;st : tsymtable);virtual;
  36. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  37. procedure ppuwrite(ppufile:tcompilerppufile);override;
  38. procedure buildderefimpl;override;
  39. procedure derefimpl;override;
  40. procedure set_mp(p:tnode);
  41. function getcopy : tnode;override;
  42. function pass_1 : tnode;override;
  43. function det_resulttype:tnode;override;
  44. procedure mark_write;override;
  45. function docompare(p: tnode): boolean; override;
  46. procedure printnodedata(var t:text);override;
  47. end;
  48. tloadnodeclass = class of tloadnode;
  49. { different assignment types }
  50. tassigntype = (at_normal,at_plus,at_minus,at_star,at_slash);
  51. tassignmentnode = class(tbinarynode)
  52. assigntype : tassigntype;
  53. constructor create(l,r : tnode);virtual;
  54. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  55. procedure ppuwrite(ppufile:tcompilerppufile);override;
  56. function getcopy : tnode;override;
  57. function pass_1 : tnode;override;
  58. function det_resulttype:tnode;override;
  59. {$ifdef state_tracking}
  60. function track_state_pass(exec_known:boolean):boolean;override;
  61. {$endif state_tracking}
  62. function docompare(p: tnode): boolean; override;
  63. end;
  64. tassignmentnodeclass = class of tassignmentnode;
  65. tarrayconstructorrangenode = class(tbinarynode)
  66. constructor create(l,r : tnode);virtual;
  67. function pass_1 : tnode;override;
  68. function det_resulttype:tnode;override;
  69. end;
  70. tarrayconstructorrangenodeclass = class of tarrayconstructorrangenode;
  71. tarrayconstructornode = class(tbinarynode)
  72. constructor create(l,r : tnode);virtual;
  73. function getcopy : tnode;override;
  74. function pass_1 : tnode;override;
  75. function det_resulttype:tnode;override;
  76. function docompare(p: tnode): boolean; override;
  77. procedure force_type(tt:ttype);
  78. procedure insert_typeconvs;
  79. end;
  80. tarrayconstructornodeclass = class of tarrayconstructornode;
  81. ttypenode = class(tnode)
  82. allowed : boolean;
  83. restype : ttype;
  84. constructor create(t : ttype);virtual;
  85. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  86. procedure ppuwrite(ppufile:tcompilerppufile);override;
  87. procedure buildderefimpl;override;
  88. procedure derefimpl;override;
  89. function pass_1 : tnode;override;
  90. function det_resulttype:tnode;override;
  91. function docompare(p: tnode): boolean; override;
  92. end;
  93. ttypenodeclass = class of ttypenode;
  94. trttinode = class(tnode)
  95. l1,l2 : longint;
  96. rttitype : trttitype;
  97. rttidef : tstoreddef;
  98. rttidefderef : tderef;
  99. constructor create(def:tstoreddef;rt:trttitype);virtual;
  100. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  101. procedure ppuwrite(ppufile:tcompilerppufile);override;
  102. procedure buildderefimpl;override;
  103. procedure derefimpl;override;
  104. function getcopy : tnode;override;
  105. function pass_1 : tnode;override;
  106. procedure pass_2;override;
  107. function det_resulttype:tnode;override;
  108. function docompare(p: tnode): boolean; override;
  109. end;
  110. trttinodeclass = class of trttinode;
  111. var
  112. cloadnode : tloadnodeclass;
  113. cassignmentnode : tassignmentnodeclass;
  114. carrayconstructorrangenode : tarrayconstructorrangenodeclass;
  115. carrayconstructornode : tarrayconstructornodeclass;
  116. ctypenode : ttypenodeclass;
  117. crttinode : trttinodeclass;
  118. procedure load_procvar_from_calln(var p1:tnode);
  119. function load_high_value_node(vs:tvarsym):tnode;
  120. function load_self_node:tnode;
  121. function load_result_node:tnode;
  122. function load_self_pointer_node:tnode;
  123. function load_vmt_pointer_node:tnode;
  124. function is_self_node(p:tnode):boolean;
  125. implementation
  126. uses
  127. cutils,verbose,globtype,globals,systems,
  128. symtable,symnot,
  129. defutil,defcmp,
  130. htypechk,pass_1,procinfo,paramgr,
  131. ncon,ninl,ncnv,nmem,ncal,cpubase,cgobj,cgbase
  132. ;
  133. {*****************************************************************************
  134. Helpers
  135. *****************************************************************************}
  136. procedure load_procvar_from_calln(var p1:tnode);
  137. var
  138. p2 : tnode;
  139. begin
  140. if p1.nodetype<>calln then
  141. internalerror(200212251);
  142. { was it a procvar, then we simply remove the calln and
  143. reuse the right }
  144. if assigned(tcallnode(p1).right) then
  145. begin
  146. p2:=tcallnode(p1).right;
  147. tcallnode(p1).right:=nil;
  148. end
  149. else
  150. begin
  151. p2:=cloadnode.create_procvar(tcallnode(p1).symtableprocentry,
  152. tprocdef(tcallnode(p1).procdefinition),tcallnode(p1).symtableproc);
  153. { when the methodpointer is typen we've something like:
  154. tobject.create. Then only the address is needed of the
  155. method without a self pointer }
  156. if assigned(tcallnode(p1).methodpointer) and
  157. (tcallnode(p1).methodpointer.nodetype<>typen) then
  158. begin
  159. tloadnode(p2).set_mp(tcallnode(p1).methodpointer);
  160. tcallnode(p1).methodpointer:=nil;
  161. end;
  162. end;
  163. resulttypepass(p2);
  164. p1.free;
  165. p1:=p2;
  166. end;
  167. function load_high_value_node(vs:tvarsym):tnode;
  168. var
  169. srsym : tsym;
  170. srsymtable : tsymtable;
  171. begin
  172. result:=nil;
  173. srsymtable:=vs.owner;
  174. srsym:=searchsymonlyin(srsymtable,'high'+vs.name);
  175. if assigned(srsym) then
  176. begin
  177. result:=cloadnode.create(srsym,srsymtable);
  178. resulttypepass(result);
  179. end
  180. else
  181. CGMessage(cg_e_illegal_expression);
  182. end;
  183. function load_self_node:tnode;
  184. var
  185. srsym : tsym;
  186. srsymtable : tsymtable;
  187. begin
  188. result:=nil;
  189. searchsym('self',srsym,srsymtable);
  190. if assigned(srsym) then
  191. begin
  192. result:=cloadnode.create(srsym,srsymtable);
  193. resulttypepass(result);
  194. end
  195. else
  196. CGMessage(cg_e_illegal_expression);
  197. end;
  198. function load_result_node:tnode;
  199. var
  200. srsym : tsym;
  201. srsymtable : tsymtable;
  202. begin
  203. result:=nil;
  204. searchsym('result',srsym,srsymtable);
  205. if assigned(srsym) then
  206. begin
  207. result:=cloadnode.create(srsym,srsymtable);
  208. resulttypepass(result);
  209. end
  210. else
  211. CGMessage(cg_e_illegal_expression);
  212. end;
  213. function load_self_pointer_node:tnode;
  214. var
  215. srsym : tsym;
  216. srsymtable : tsymtable;
  217. begin
  218. result:=nil;
  219. searchsym('self',srsym,srsymtable);
  220. if assigned(srsym) then
  221. begin
  222. result:=cloadnode.create(srsym,srsymtable);
  223. include(result.flags,nf_load_self_pointer);
  224. resulttypepass(result);
  225. end
  226. else
  227. CGMessage(cg_e_illegal_expression);
  228. end;
  229. function load_vmt_pointer_node:tnode;
  230. var
  231. srsym : tsym;
  232. srsymtable : tsymtable;
  233. begin
  234. result:=nil;
  235. searchsym('vmt',srsym,srsymtable);
  236. if assigned(srsym) then
  237. begin
  238. result:=cloadnode.create(srsym,srsymtable);
  239. resulttypepass(result);
  240. end
  241. else
  242. CGMessage(cg_e_illegal_expression);
  243. end;
  244. function is_self_node(p:tnode):boolean;
  245. begin
  246. is_self_node:=(p.nodetype=loadn) and
  247. (tloadnode(p).symtableentry.typ=varsym) and
  248. (vo_is_self in tvarsym(tloadnode(p).symtableentry).varoptions);
  249. end;
  250. {*****************************************************************************
  251. TLOADNODE
  252. *****************************************************************************}
  253. constructor tloadnode.create(v : tsym;st : tsymtable);
  254. begin
  255. inherited create(loadn,nil);
  256. if not assigned(v) then
  257. internalerror(200108121);
  258. symtableentry:=v;
  259. symtable:=st;
  260. procdef:=nil;
  261. end;
  262. constructor tloadnode.create_procvar(v : tsym;d:tprocdef;st : tsymtable);
  263. begin
  264. inherited create(loadn,nil);
  265. if not assigned(v) then
  266. internalerror(200108121);
  267. symtableentry:=v;
  268. symtable:=st;
  269. procdef:=d;
  270. end;
  271. constructor tloadnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  272. begin
  273. inherited ppuload(t,ppufile);
  274. ppufile.getderef(symtableentryderef);
  275. symtable:=nil;
  276. ppufile.getderef(procdefderef);
  277. end;
  278. procedure tloadnode.ppuwrite(ppufile:tcompilerppufile);
  279. begin
  280. inherited ppuwrite(ppufile);
  281. ppufile.putderef(symtableentryderef);
  282. ppufile.putderef(procdefderef);
  283. end;
  284. procedure tloadnode.buildderefimpl;
  285. begin
  286. inherited buildderefimpl;
  287. symtableentryderef.build(symtableentry);
  288. procdefderef.build(procdef);
  289. end;
  290. procedure tloadnode.derefimpl;
  291. begin
  292. inherited derefimpl;
  293. symtableentry:=tsym(symtableentryderef.resolve);
  294. symtable:=symtableentry.owner;
  295. procdef:=tprocdef(procdefderef.resolve);
  296. end;
  297. procedure tloadnode.set_mp(p:tnode);
  298. begin
  299. { typen nodes should not be set }
  300. if p.nodetype=typen then
  301. internalerror(200301042);
  302. left:=p;
  303. end;
  304. function tloadnode.getcopy : tnode;
  305. var
  306. n : tloadnode;
  307. begin
  308. n:=tloadnode(inherited getcopy);
  309. n.symtable:=symtable;
  310. n.symtableentry:=symtableentry;
  311. n.procdef:=procdef;
  312. result:=n;
  313. end;
  314. function tloadnode.det_resulttype:tnode;
  315. begin
  316. result:=nil;
  317. case symtableentry.typ of
  318. absolutesym :
  319. resulttype:=tabsolutesym(symtableentry).vartype;
  320. constsym:
  321. begin
  322. if tconstsym(symtableentry).consttyp=constresourcestring then
  323. resulttype:=cansistringtype
  324. else
  325. internalerror(22799);
  326. end;
  327. varsym :
  328. begin
  329. inc(tvarsym(symtableentry).refs);
  330. { Nested variable? The we need to load the framepointer of
  331. the parent procedure }
  332. if (symtable.symtabletype in [localsymtable,parasymtable]) and
  333. (symtable.symtablelevel<>current_procinfo.procdef.parast.symtablelevel) then
  334. begin
  335. if assigned(left) then
  336. internalerror(200309289);
  337. left:=cloadparentfpnode.create(tprocdef(symtable.defowner));
  338. end;
  339. { fix self type which is declared as voidpointer in the
  340. definition }
  341. if vo_is_self in tvarsym(symtableentry).varoptions then
  342. begin
  343. resulttype.setdef(tprocdef(symtableentry.owner.defowner)._class);
  344. if (po_classmethod in tprocdef(symtableentry.owner.defowner).procoptions) or
  345. (po_staticmethod in tprocdef(symtableentry.owner.defowner).procoptions) then
  346. resulttype.setdef(tclassrefdef.create(resulttype))
  347. else if is_object(resulttype.def) and
  348. (nf_load_self_pointer in flags) then
  349. resulttype.setdef(tpointerdef.create(resulttype));
  350. end
  351. else if vo_is_vmt in tvarsym(symtableentry).varoptions then
  352. begin
  353. resulttype.setdef(tprocdef(symtableentry.owner.defowner)._class);
  354. resulttype.setdef(tclassrefdef.create(resulttype));
  355. end
  356. else
  357. resulttype:=tvarsym(symtableentry).vartype;
  358. end;
  359. typedconstsym :
  360. resulttype:=ttypedconstsym(symtableentry).typedconsttype;
  361. procsym :
  362. begin
  363. if not assigned(procdef) then
  364. begin
  365. if Tprocsym(symtableentry).procdef_count>1 then
  366. CGMessage(parser_e_no_overloaded_procvars);
  367. procdef:=tprocsym(symtableentry).first_procdef;
  368. end;
  369. { the result is a procdef, addrn and proc_to_procvar
  370. typeconvn need this as resulttype so they know
  371. that the address needs to be returned }
  372. resulttype.setdef(procdef);
  373. { process methodpointer }
  374. if assigned(left) then
  375. resulttypepass(left);
  376. end;
  377. else
  378. internalerror(200104141);
  379. end;
  380. end;
  381. procedure Tloadnode.mark_write;
  382. begin
  383. include(flags,nf_write);
  384. end;
  385. function tloadnode.pass_1 : tnode;
  386. begin
  387. result:=nil;
  388. expectloc:=LOC_REFERENCE;
  389. registersint:=0;
  390. registersfpu:=0;
  391. {$ifdef SUPPORT_MMX}
  392. registersmmx:=0;
  393. {$endif SUPPORT_MMX}
  394. case symtableentry.typ of
  395. absolutesym :
  396. ;
  397. constsym:
  398. begin
  399. if tconstsym(symtableentry).consttyp=constresourcestring then
  400. begin
  401. include(current_procinfo.flags,pi_needs_implicit_finally);
  402. expectloc:=LOC_CREFERENCE;
  403. end;
  404. end;
  405. varsym :
  406. begin
  407. if assigned(left) then
  408. firstpass(left);
  409. if (tvarsym(symtableentry).varspez=vs_const) then
  410. expectloc:=LOC_CREFERENCE;
  411. { we need a register for call by reference parameters }
  412. if paramanager.push_addr_param(tvarsym(symtableentry).varspez,tvarsym(symtableentry).vartype.def,pocall_default) then
  413. registersint:=1;
  414. if ([vo_is_thread_var,vo_is_dll_var]*tvarsym(symtableentry).varoptions)<>[] then
  415. registersint:=1;
  416. { call to get address of threadvar }
  417. if (vo_is_thread_var in tvarsym(symtableentry).varoptions) then
  418. include(current_procinfo.flags,pi_do_call);
  419. if nf_write in flags then
  420. Tvarsym(symtableentry).trigger_notifications(vn_onwrite)
  421. else
  422. Tvarsym(symtableentry).trigger_notifications(vn_onread);
  423. { count variable references }
  424. if cg.t_times>1 then
  425. inc(tvarsym(symtableentry).refs,cg.t_times-1);
  426. end;
  427. typedconstsym :
  428. ;
  429. procsym :
  430. begin
  431. { method pointer ? }
  432. if assigned(left) then
  433. begin
  434. expectloc:=LOC_CREFERENCE;
  435. firstpass(left);
  436. registersint:=max(registersint,left.registersint);
  437. registersfpu:=max(registersfpu,left.registersfpu);
  438. {$ifdef SUPPORT_MMX}
  439. registersmmx:=max(registersmmx,left.registersmmx);
  440. {$endif SUPPORT_MMX}
  441. end;
  442. end;
  443. else
  444. internalerror(200104143);
  445. end;
  446. end;
  447. function tloadnode.docompare(p: tnode): boolean;
  448. begin
  449. docompare :=
  450. inherited docompare(p) and
  451. (symtableentry = tloadnode(p).symtableentry) and
  452. (procdef = tloadnode(p).procdef) and
  453. (symtable = tloadnode(p).symtable);
  454. end;
  455. procedure Tloadnode.printnodedata(var t:text);
  456. begin
  457. inherited printnodedata(t);
  458. write(t,printnodeindention,'symbol = ',symtableentry.name);
  459. if symtableentry.typ=procsym then
  460. write(t,printnodeindention,'procdef = ',procdef.mangledname);
  461. writeln(t,'');
  462. end;
  463. {*****************************************************************************
  464. TASSIGNMENTNODE
  465. *****************************************************************************}
  466. constructor tassignmentnode.create(l,r : tnode);
  467. begin
  468. inherited create(assignn,l,r);
  469. l.mark_write;
  470. assigntype:=at_normal;
  471. end;
  472. constructor tassignmentnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  473. begin
  474. inherited ppuload(t,ppufile);
  475. assigntype:=tassigntype(ppufile.getbyte);
  476. end;
  477. procedure tassignmentnode.ppuwrite(ppufile:tcompilerppufile);
  478. begin
  479. inherited ppuwrite(ppufile);
  480. ppufile.putbyte(byte(assigntype));
  481. end;
  482. function tassignmentnode.getcopy : tnode;
  483. var
  484. n : tassignmentnode;
  485. begin
  486. n:=tassignmentnode(inherited getcopy);
  487. n.assigntype:=assigntype;
  488. getcopy:=n;
  489. end;
  490. function tassignmentnode.det_resulttype:tnode;
  491. var
  492. hp : tnode;
  493. useshelper : boolean;
  494. original_size : longint;
  495. begin
  496. result:=nil;
  497. resulttype:=voidtype;
  498. original_size := 0;
  499. { must be made unique }
  500. set_unique(left);
  501. resulttypepass(left);
  502. if is_ansistring(left.resulttype.def) then
  503. begin
  504. { fold <ansistring>:=<ansistring>+<char|shortstring|ansistring> }
  505. if (right.nodetype=addn) and
  506. left.isequal(tbinarynode(right).left) and
  507. { don't fold multiple concatenations else we could get trouble
  508. with multiple uses of s
  509. }
  510. (tbinarynode(right).left.nodetype<>addn) and
  511. (tbinarynode(right).right.nodetype<>addn) then
  512. begin
  513. { don't do a resulttypepass(right), since then the addnode }
  514. { may insert typeconversions that make this optimization }
  515. { opportunity quite difficult to detect (JM) }
  516. resulttypepass(tbinarynode(right).left);
  517. resulttypepass(tbinarynode(right).right);
  518. if (is_char(tbinarynode(right).right.resulttype.def) or
  519. is_shortstring(tbinarynode(right).right.resulttype.def) or
  520. is_ansistring(tbinarynode(right).right.resulttype.def)) then
  521. begin
  522. { remove property flag so it'll not trigger an error }
  523. exclude(left.flags,nf_isproperty);
  524. { generate call to helper }
  525. hp:=ccallparanode.create(tbinarynode(right).right,
  526. ccallparanode.create(left,nil));
  527. if is_char(tbinarynode(right).right.resulttype.def) then
  528. result:=ccallnode.createintern('fpc_ansistr_append_char',hp)
  529. else if is_shortstring(tbinarynode(right).right.resulttype.def) then
  530. result:=ccallnode.createintern('fpc_ansistr_append_shortstring',hp)
  531. else
  532. result:=ccallnode.createintern('fpc_ansistr_append_ansistring',hp);
  533. tbinarynode(right).right:=nil;
  534. left:=nil;
  535. exit;
  536. end;
  537. end;
  538. end
  539. else
  540. if is_shortstring(left.resulttype.def) then
  541. begin
  542. { fold <shortstring>:=<shortstring>+<shortstring>,
  543. <shortstring>+<char> is handled by an optimized node }
  544. if (right.nodetype=addn) and
  545. left.isequal(tbinarynode(right).left) and
  546. { don't fold multiple concatenations else we could get trouble
  547. with multiple uses of s }
  548. (tbinarynode(right).left.nodetype<>addn) and
  549. (tbinarynode(right).right.nodetype<>addn) then
  550. begin
  551. { don't do a resulttypepass(right), since then the addnode }
  552. { may insert typeconversions that make this optimization }
  553. { opportunity quite difficult to detect (JM) }
  554. resulttypepass(tbinarynode(right).left);
  555. resulttypepass(tbinarynode(right).right);
  556. if is_shortstring(tbinarynode(right).right.resulttype.def) then
  557. begin
  558. { remove property flag so it'll not trigger an error }
  559. exclude(left.flags,nf_isproperty);
  560. { generate call to helper }
  561. hp:=ccallparanode.create(tbinarynode(right).right,
  562. ccallparanode.create(left,nil));
  563. if is_shortstring(tbinarynode(right).right.resulttype.def) then
  564. result:=ccallnode.createintern('fpc_shortstr_append_shortstr',hp);
  565. tbinarynode(right).right:=nil;
  566. left:=nil;
  567. exit;
  568. end;
  569. end;
  570. end;
  571. resulttypepass(right);
  572. set_varstate(left,vs_assigned,false);
  573. set_varstate(right,vs_used,true);
  574. if codegenerror then
  575. exit;
  576. { assignments to formaldefs and open arrays aren't allowed }
  577. if (left.resulttype.def.deftype=formaldef) or
  578. is_open_array(left.resulttype.def) then
  579. CGMessage(type_e_operator_not_allowed);
  580. { test if node can be assigned, properties are allowed }
  581. valid_for_assignment(left);
  582. { assigning nil to a dynamic array clears the array }
  583. if is_dynamic_array(left.resulttype.def) and
  584. (right.nodetype=niln) then
  585. begin
  586. hp:=ccallparanode.create(caddrnode.create
  587. (crttinode.create(tstoreddef(left.resulttype.def),initrtti)),
  588. ccallparanode.create(ctypeconvnode.create_explicit(left,voidpointertype),nil));
  589. result := ccallnode.createintern('fpc_dynarray_clear',hp);
  590. left:=nil;
  591. exit;
  592. end;
  593. { shortstring helpers can do the conversion directly,
  594. so treat them separatly }
  595. if (is_shortstring(left.resulttype.def)) then
  596. begin
  597. { insert typeconv, except for chars that are handled in
  598. secondpass and except for ansi/wide string that can
  599. be converted immediatly }
  600. if not(is_char(right.resulttype.def) or
  601. (right.resulttype.def.deftype=stringdef)) then
  602. inserttypeconv(right,left.resulttype);
  603. if right.resulttype.def.deftype=stringdef then
  604. begin
  605. useshelper:=true;
  606. { convert constant strings to shortstrings. But
  607. skip empty constant strings, that will be handled
  608. in secondpass }
  609. if (right.nodetype=stringconstn) then
  610. begin
  611. { verify if range fits within shortstring }
  612. { just emit a warning, delphi gives an }
  613. { error, only if the type definition of }
  614. { of the string is less < 255 characters }
  615. if not is_open_string(left.resulttype.def) and
  616. (tstringconstnode(right).len > tstringdef(left.resulttype.def).len) then
  617. cgmessage(type_w_string_too_long);
  618. inserttypeconv(right,left.resulttype);
  619. if (tstringconstnode(right).len=0) then
  620. useshelper:=false;
  621. end;
  622. { rest is done in pass 1 (JM) }
  623. if useshelper then
  624. exit;
  625. end
  626. end
  627. else
  628. begin
  629. { get the size before the type conversion - check for all nodes }
  630. if assigned(right.resulttype.def) and
  631. (right.resulttype.def.deftype in [enumdef,orddef,floatdef]) and
  632. (right.nodetype in [loadn,vecn,calln]) then
  633. original_size := right.resulttype.def.size;
  634. inserttypeconv(right,left.resulttype);
  635. end;
  636. { check if the assignment may cause a range check error }
  637. { if its not explicit, and only if the values are }
  638. { ordinals, enumdef and floatdef }
  639. if (right.nodetype = typeconvn) and
  640. not (nf_explicit in ttypeconvnode(right).flags) then
  641. begin
  642. if assigned(left.resulttype.def) and
  643. (left.resulttype.def.deftype in [enumdef,orddef,floatdef]) then
  644. begin
  645. if (original_size <> 0) and (left.resulttype.def.size < original_size) then
  646. begin
  647. if (cs_check_range in aktlocalswitches) then
  648. Message(type_w_smaller_possible_range_check)
  649. else
  650. Message(type_h_smaller_possible_range_check);
  651. end;
  652. end;
  653. end;
  654. { call helpers for interface }
  655. if is_interfacecom(left.resulttype.def) then
  656. begin
  657. hp:=ccallparanode.create(ctypeconvnode.create_explicit
  658. (right,voidpointertype),
  659. ccallparanode.create(ctypeconvnode.create_explicit
  660. (left,voidpointertype),nil));
  661. result:=ccallnode.createintern('fpc_intf_assign',hp);
  662. left:=nil;
  663. right:=nil;
  664. exit;
  665. end;
  666. { check if local proc/func is assigned to procvar }
  667. if right.resulttype.def.deftype=procvardef then
  668. test_local_to_procvar(tprocvardef(right.resulttype.def),left.resulttype.def);
  669. end;
  670. function tassignmentnode.pass_1 : tnode;
  671. var
  672. hp: tnode;
  673. begin
  674. result:=nil;
  675. expectloc:=LOC_VOID;
  676. firstpass(left);
  677. firstpass(right);
  678. { assignment to refcounted variable -> inc/decref }
  679. if (not is_class(left.resulttype.def) and
  680. left.resulttype.def.needs_inittable) then
  681. include(current_procinfo.flags,pi_do_call);
  682. if codegenerror then
  683. exit;
  684. if (is_shortstring(left.resulttype.def)) then
  685. begin
  686. if right.resulttype.def.deftype=stringdef then
  687. begin
  688. if (right.nodetype<>stringconstn) or
  689. (tstringconstnode(right).len<>0) then
  690. begin
  691. if (cs_optimize in aktglobalswitches) and
  692. (right.nodetype in [calln,blockn]) and
  693. (left.nodetype = temprefn) and
  694. is_shortstring(right.resulttype.def) and
  695. not is_open_string(left.resulttype.def) and
  696. (tstringdef(left.resulttype.def).len = 255) then
  697. begin
  698. { the blocknode case is handled in pass_2 at the temp }
  699. { reference level (mainly for callparatemp) (JM) }
  700. if (right.nodetype = calln) then
  701. begin
  702. tcallnode(right).funcretnode := left;
  703. result := right;
  704. end
  705. else
  706. exit;
  707. end
  708. else
  709. begin
  710. hp:=ccallparanode.create
  711. (right,
  712. ccallparanode.create(cinlinenode.create
  713. (in_high_x,false,left.getcopy),nil));
  714. result:=ccallnode.createinternreturn('fpc_'+tstringdef(right.resulttype.def).stringtypname+'_to_shortstr',hp,left);
  715. firstpass(result);
  716. end;
  717. left:=nil;
  718. right:=nil;
  719. exit;
  720. end;
  721. end;
  722. end;
  723. if (cs_optimize in aktglobalswitches) and
  724. (right.nodetype = calln) and
  725. { left must be a temp, since otherwise as soon as you modify the }
  726. { result, the current left node is modified and that one may }
  727. { still be an argument to the function or even accessed in the }
  728. { function }
  729. (((left.nodetype = temprefn) and
  730. paramanager.ret_in_param(right.resulttype.def,
  731. tcallnode(right).procdefinition.proccalloption)) or
  732. { there's special support for ansi/widestrings in the callnode }
  733. is_ansistring(right.resulttype.def) or
  734. is_widestring(right.resulttype.def)) then
  735. begin
  736. tcallnode(right).funcretnode := left;
  737. result := right;
  738. left := nil;
  739. right := nil;
  740. exit;
  741. end;
  742. registersint:=left.registersint+right.registersint;
  743. registersfpu:=max(left.registersfpu,right.registersfpu);
  744. {$ifdef SUPPORT_MMX}
  745. registersmmx:=max(left.registersmmx,right.registersmmx);
  746. {$endif SUPPORT_MMX}
  747. end;
  748. function tassignmentnode.docompare(p: tnode): boolean;
  749. begin
  750. docompare :=
  751. inherited docompare(p) and
  752. (assigntype = tassignmentnode(p).assigntype);
  753. end;
  754. {$ifdef state_tracking}
  755. function Tassignmentnode.track_state_pass(exec_known:boolean):boolean;
  756. var se:Tstate_entry;
  757. begin
  758. track_state_pass:=false;
  759. if exec_known then
  760. begin
  761. track_state_pass:=right.track_state_pass(exec_known);
  762. {Force a new resulttype pass.}
  763. right.resulttype.def:=nil;
  764. do_resulttypepass(right);
  765. resulttypepass(right);
  766. aktstate.store_fact(left.getcopy,right.getcopy);
  767. end
  768. else
  769. aktstate.delete_fact(left);
  770. end;
  771. {$endif}
  772. {*****************************************************************************
  773. TARRAYCONSTRUCTORRANGENODE
  774. *****************************************************************************}
  775. constructor tarrayconstructorrangenode.create(l,r : tnode);
  776. begin
  777. inherited create(arrayconstructorrangen,l,r);
  778. end;
  779. function tarrayconstructorrangenode.det_resulttype:tnode;
  780. begin
  781. result:=nil;
  782. resulttypepass(left);
  783. resulttypepass(right);
  784. set_varstate(left,vs_used,true);
  785. set_varstate(right,vs_used,true);
  786. if codegenerror then
  787. exit;
  788. resulttype:=left.resulttype;
  789. end;
  790. function tarrayconstructorrangenode.pass_1 : tnode;
  791. begin
  792. firstpass(left);
  793. firstpass(right);
  794. expectloc:=LOC_CREFERENCE;
  795. calcregisters(self,0,0,0);
  796. result:=nil;
  797. end;
  798. {****************************************************************************
  799. TARRAYCONSTRUCTORNODE
  800. *****************************************************************************}
  801. constructor tarrayconstructornode.create(l,r : tnode);
  802. begin
  803. inherited create(arrayconstructorn,l,r);
  804. end;
  805. function tarrayconstructornode.getcopy : tnode;
  806. var
  807. n : tarrayconstructornode;
  808. begin
  809. n:=tarrayconstructornode(inherited getcopy);
  810. result:=n;
  811. end;
  812. function tarrayconstructornode.det_resulttype:tnode;
  813. var
  814. htype : ttype;
  815. hp : tarrayconstructornode;
  816. len : longint;
  817. varia : boolean;
  818. begin
  819. result:=nil;
  820. { are we allowing array constructor? Then convert it to a set }
  821. if not allow_array_constructor then
  822. begin
  823. hp:=tarrayconstructornode(getcopy);
  824. arrayconstructor_to_set(tnode(hp));
  825. result:=hp;
  826. exit;
  827. end;
  828. { only pass left tree, right tree contains next construct if any }
  829. htype.reset;
  830. len:=0;
  831. varia:=false;
  832. if assigned(left) then
  833. begin
  834. hp:=self;
  835. while assigned(hp) do
  836. begin
  837. resulttypepass(hp.left);
  838. set_varstate(hp.left,vs_used,true);
  839. if (htype.def=nil) then
  840. htype:=hp.left.resulttype
  841. else
  842. begin
  843. if ((nf_novariaallowed in flags) or (not varia)) and
  844. (not equal_defs(htype.def,hp.left.resulttype.def)) then
  845. begin
  846. varia:=true;
  847. end;
  848. end;
  849. inc(len);
  850. hp:=tarrayconstructornode(hp.right);
  851. end;
  852. end;
  853. if not assigned(htype.def) then
  854. htype:=voidtype;
  855. resulttype.setdef(tarraydef.create(0,len-1,s32inttype));
  856. tarraydef(resulttype.def).setelementtype(htype);
  857. tarraydef(resulttype.def).IsConstructor:=true;
  858. tarraydef(resulttype.def).IsVariant:=varia;
  859. end;
  860. procedure tarrayconstructornode.force_type(tt:ttype);
  861. var
  862. hp : tarrayconstructornode;
  863. begin
  864. tarraydef(resulttype.def).setelementtype(tt);
  865. tarraydef(resulttype.def).IsConstructor:=true;
  866. tarraydef(resulttype.def).IsVariant:=false;
  867. if assigned(left) then
  868. begin
  869. hp:=self;
  870. while assigned(hp) do
  871. begin
  872. inserttypeconv(hp.left,tt);
  873. hp:=tarrayconstructornode(hp.right);
  874. end;
  875. end;
  876. end;
  877. procedure tarrayconstructornode.insert_typeconvs;
  878. var
  879. thp,
  880. chp,
  881. hp : tarrayconstructornode;
  882. dovariant : boolean;
  883. htype : ttype;
  884. orgflags : tnodeflags;
  885. begin
  886. dovariant:=(nf_forcevaria in flags) or tarraydef(resulttype.def).isvariant;
  887. { only pass left tree, right tree contains next construct if any }
  888. if assigned(left) then
  889. begin
  890. hp:=self;
  891. while assigned(hp) do
  892. begin
  893. resulttypepass(hp.left);
  894. { Insert typeconvs for array of const }
  895. if dovariant then
  896. begin
  897. case hp.left.resulttype.def.deftype of
  898. enumdef :
  899. hp.left:=ctypeconvnode.create_explicit(hp.left,s32inttype);
  900. arraydef :
  901. hp.left:=ctypeconvnode.create(hp.left,charpointertype);
  902. orddef :
  903. begin
  904. if is_integer(hp.left.resulttype.def) and
  905. not(is_64bitint(hp.left.resulttype.def)) then
  906. hp.left:=ctypeconvnode.create(hp.left,s32inttype);
  907. end;
  908. floatdef :
  909. hp.left:=ctypeconvnode.create(hp.left,pbestrealtype^);
  910. procvardef :
  911. hp.left:=ctypeconvnode.create(hp.left,voidpointertype);
  912. stringdef,
  913. variantdef,
  914. pointerdef,
  915. classrefdef,
  916. objectdef : ;
  917. else
  918. CGMessagePos1(hp.left.fileinfo,type_e_wrong_type_in_array_constructor,hp.left.resulttype.def.typename);
  919. end;
  920. end;
  921. resulttypepass(hp.left);
  922. hp:=tarrayconstructornode(hp.right);
  923. end;
  924. end;
  925. end;
  926. function tarrayconstructornode.pass_1 : tnode;
  927. var
  928. hp : tarrayconstructornode;
  929. begin
  930. result:=nil;
  931. { Insert required type convs, this must be
  932. done in pass 1, because the call must be
  933. resulttypepassed already }
  934. if assigned(left) then
  935. begin
  936. insert_typeconvs;
  937. { call firstpass for all nodes }
  938. hp:=self;
  939. while assigned(hp) do
  940. begin
  941. firstpass(hp.left);
  942. hp:=tarrayconstructornode(hp.right);
  943. end;
  944. end;
  945. expectloc:=LOC_CREFERENCE;
  946. calcregisters(self,0,0,0);
  947. end;
  948. function tarrayconstructornode.docompare(p: tnode): boolean;
  949. begin
  950. docompare :=
  951. inherited docompare(p);
  952. end;
  953. {*****************************************************************************
  954. TTYPENODE
  955. *****************************************************************************}
  956. constructor ttypenode.create(t : ttype);
  957. begin
  958. inherited create(typen);
  959. restype:=t;
  960. allowed:=false;
  961. end;
  962. constructor ttypenode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  963. begin
  964. inherited ppuload(t,ppufile);
  965. ppufile.gettype(restype);
  966. allowed:=boolean(ppufile.getbyte);
  967. end;
  968. procedure ttypenode.ppuwrite(ppufile:tcompilerppufile);
  969. begin
  970. inherited ppuwrite(ppufile);
  971. ppufile.puttype(restype);
  972. ppufile.putbyte(byte(allowed));
  973. end;
  974. procedure ttypenode.buildderefimpl;
  975. begin
  976. inherited buildderefimpl;
  977. restype.buildderef;
  978. end;
  979. procedure ttypenode.derefimpl;
  980. begin
  981. inherited derefimpl;
  982. restype.resolve;
  983. end;
  984. function ttypenode.det_resulttype:tnode;
  985. begin
  986. result:=nil;
  987. resulttype:=restype;
  988. { check if it's valid }
  989. if restype.def.deftype = errordef then
  990. CGMessage(cg_e_illegal_expression);
  991. end;
  992. function ttypenode.pass_1 : tnode;
  993. begin
  994. result:=nil;
  995. expectloc:=LOC_VOID;
  996. { a typenode can't generate code, so we give here
  997. an error. Else it'll be an abstract error in pass_2.
  998. Only when the allowed flag is set we don't generate
  999. an error }
  1000. if not allowed then
  1001. Message(parser_e_no_type_not_allowed_here);
  1002. end;
  1003. function ttypenode.docompare(p: tnode): boolean;
  1004. begin
  1005. docompare :=
  1006. inherited docompare(p);
  1007. end;
  1008. {*****************************************************************************
  1009. TRTTINODE
  1010. *****************************************************************************}
  1011. constructor trttinode.create(def:tstoreddef;rt:trttitype);
  1012. begin
  1013. inherited create(rttin);
  1014. rttidef:=def;
  1015. rttitype:=rt;
  1016. end;
  1017. constructor trttinode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  1018. begin
  1019. inherited ppuload(t,ppufile);
  1020. ppufile.getderef(rttidefderef);
  1021. rttitype:=trttitype(ppufile.getbyte);
  1022. end;
  1023. procedure trttinode.ppuwrite(ppufile:tcompilerppufile);
  1024. begin
  1025. inherited ppuwrite(ppufile);
  1026. ppufile.putderef(rttidefderef);
  1027. ppufile.putbyte(byte(rttitype));
  1028. end;
  1029. procedure trttinode.buildderefimpl;
  1030. begin
  1031. inherited buildderefimpl;
  1032. rttidefderef.build(rttidef);
  1033. end;
  1034. procedure trttinode.derefimpl;
  1035. begin
  1036. inherited derefimpl;
  1037. rttidef:=tstoreddef(rttidefderef.resolve);
  1038. end;
  1039. function trttinode.getcopy : tnode;
  1040. var
  1041. n : trttinode;
  1042. begin
  1043. n:=trttinode(inherited getcopy);
  1044. n.rttidef:=rttidef;
  1045. n.rttitype:=rttitype;
  1046. result:=n;
  1047. end;
  1048. function trttinode.det_resulttype:tnode;
  1049. begin
  1050. { rtti information will be returned as a void pointer }
  1051. result:=nil;
  1052. resulttype:=voidpointertype;
  1053. end;
  1054. function trttinode.pass_1 : tnode;
  1055. begin
  1056. result:=nil;
  1057. expectloc:=LOC_CREFERENCE;
  1058. end;
  1059. function trttinode.docompare(p: tnode): boolean;
  1060. begin
  1061. docompare :=
  1062. inherited docompare(p) and
  1063. (rttidef = trttinode(p).rttidef) and
  1064. (rttitype = trttinode(p).rttitype);
  1065. end;
  1066. procedure trttinode.pass_2;
  1067. begin
  1068. location_reset(location,LOC_CREFERENCE,OS_NO);
  1069. location.reference.symbol:=rttidef.get_rtti_label(rttitype);
  1070. end;
  1071. begin
  1072. cloadnode:=tloadnode;
  1073. cassignmentnode:=tassignmentnode;
  1074. carrayconstructorrangenode:=tarrayconstructorrangenode;
  1075. carrayconstructornode:=tarrayconstructornode;
  1076. ctypenode:=ttypenode;
  1077. crttinode:=trttinode;
  1078. end.
  1079. {
  1080. $Log$
  1081. Revision 1.121 2004-02-03 22:32:54 peter
  1082. * renamed xNNbittype to xNNinttype
  1083. * renamed registers32 to registersint
  1084. * replace some s32bit,u32bit with torddef([su]inttype).def.typ
  1085. Revision 1.120 2004/01/26 16:12:28 daniel
  1086. * reginfo now also only allocated during register allocation
  1087. * third round of gdb cleanups: kick out most of concatstabto
  1088. Revision 1.119 2003/12/01 18:44:15 peter
  1089. * fixed some crashes
  1090. * fixed varargs and register calling probs
  1091. Revision 1.118 2003/11/26 14:25:26 michael
  1092. + Applied patch from peter to support ansistrings in array constructors
  1093. Revision 1.117 2003/11/23 17:39:33 peter
  1094. * removed obsolete nf_cargs flag
  1095. Revision 1.116 2003/10/28 15:36:01 peter
  1096. * absolute to object field supported, fixes tb0458
  1097. Revision 1.115 2003/10/23 14:44:07 peter
  1098. * splitted buildderef and buildderefimpl to fix interface crc
  1099. calculation
  1100. Revision 1.114 2003/10/22 20:40:00 peter
  1101. * write derefdata in a separate ppu entry
  1102. Revision 1.113 2003/10/17 14:38:32 peter
  1103. * 64k registers supported
  1104. * fixed some memory leaks
  1105. Revision 1.112 2003/10/10 17:48:13 peter
  1106. * old trgobj moved to x86/rgcpu and renamed to trgx86fpu
  1107. * tregisteralloctor renamed to trgobj
  1108. * removed rgobj from a lot of units
  1109. * moved location_* and reference_* to cgobj
  1110. * first things for mmx register allocation
  1111. Revision 1.111 2003/10/09 21:31:37 daniel
  1112. * Register allocator splitted, ans abstract now
  1113. Revision 1.110 2003/10/08 19:19:45 peter
  1114. * set_varstate cleanup
  1115. Revision 1.109 2003/10/05 21:21:52 peter
  1116. * c style array of const generates callparanodes
  1117. * varargs paraloc fixes
  1118. Revision 1.108 2003/10/01 20:34:48 peter
  1119. * procinfo unit contains tprocinfo
  1120. * cginfo renamed to cgbase
  1121. * moved cgmessage to verbose
  1122. * fixed ppc and sparc compiles
  1123. Revision 1.107 2003/09/28 17:55:03 peter
  1124. * parent framepointer changed to hidden parameter
  1125. * tloadparentfpnode added
  1126. Revision 1.106 2003/09/23 17:56:05 peter
  1127. * locals and paras are allocated in the code generation
  1128. * tvarsym.localloc contains the location of para/local when
  1129. generating code for the current procedure
  1130. Revision 1.105 2003/09/16 16:17:01 peter
  1131. * varspez in calls to push_addr_param
  1132. Revision 1.104 2003/09/07 22:09:35 peter
  1133. * preparations for different default calling conventions
  1134. * various RA fixes
  1135. Revision 1.103 2003/07/08 15:20:56 peter
  1136. * don't allow add/assignments for formaldef
  1137. * formaldef size changed to 0
  1138. Revision 1.102 2003/06/13 21:19:30 peter
  1139. * current_procdef removed, use current_procinfo.procdef instead
  1140. Revision 1.101 2003/06/08 20:01:53 jonas
  1141. * optimized assignments with on the right side a function that returns
  1142. an ansi- or widestring
  1143. Revision 1.100 2003/06/08 18:27:15 jonas
  1144. + ability to change the location of a ttempref node with changelocation()
  1145. method. Useful to use instead of copying the contents from one temp to
  1146. another
  1147. + some shortstring optimizations in tassignmentnode that avoid some
  1148. copying (required some shortstring optimizations to be moved from
  1149. resulttype to firstpass, because they work on callnodes and string
  1150. addnodes are only changed to callnodes in the firstpass)
  1151. * allow setting/changing the funcretnode of callnodes after the
  1152. resulttypepass has been done, funcretnode is now a property
  1153. (all of the above should have a quite big effect on callparatemp)
  1154. Revision 1.99 2003/06/07 20:26:32 peter
  1155. * re-resolving added instead of reloading from ppu
  1156. * tderef object added to store deref info for resolving
  1157. Revision 1.98 2003/06/07 18:57:04 jonas
  1158. + added freeintparaloc
  1159. * ppc get/freeintparaloc now check whether the parameter regs are
  1160. properly allocated/deallocated (and get an extra list para)
  1161. * ppc a_call_* now internalerrors if pi_do_call is not yet set
  1162. * fixed lot of missing pi_do_call's
  1163. Revision 1.97 2003/06/07 14:39:18 jonas
  1164. * set pi_do_call for accesses to threadvars
  1165. Revision 1.96 2003/05/26 19:38:28 peter
  1166. * generic fpc_shorstr_concat
  1167. + fpc_shortstr_append_shortstr optimization
  1168. Revision 1.95 2003/05/23 17:05:13 peter
  1169. * loadn procsym need to return procdef
  1170. Revision 1.94 2003/05/23 14:27:35 peter
  1171. * remove some unit dependencies
  1172. * current_procinfo changes to store more info
  1173. Revision 1.93 2003/05/11 21:37:03 peter
  1174. * moved implicit exception frame from ncgutil to psub
  1175. * constructor/destructor helpers moved from cobj/ncgutil to psub
  1176. Revision 1.92 2003/05/11 14:45:12 peter
  1177. * tloadnode does not support objectsymtable,withsymtable anymore
  1178. * withnode cleanup
  1179. * direct with rewritten to use temprefnode
  1180. Revision 1.91 2003/05/09 17:47:02 peter
  1181. * self moved to hidden parameter
  1182. * removed hdisposen,hnewn,selfn
  1183. Revision 1.90 2003/04/27 11:21:33 peter
  1184. * aktprocdef renamed to current_procinfo.procdef
  1185. * procinfo renamed to current_procinfo
  1186. * procinfo will now be stored in current_module so it can be
  1187. cleaned up properly
  1188. * gen_main_procsym changed to create_main_proc and release_main_proc
  1189. to also generate a tprocinfo structure
  1190. * fixed unit implicit initfinal
  1191. Revision 1.89 2003/04/27 07:29:50 peter
  1192. * current_procinfo.procdef cleanup, current_procdef is now always nil when parsing
  1193. a new procdef declaration
  1194. * aktprocsym removed
  1195. * lexlevel removed, use symtable.symtablelevel instead
  1196. * implicit init/final code uses the normal genentry/genexit
  1197. * funcret state checking updated for new funcret handling
  1198. Revision 1.88 2003/04/26 00:28:42 peter
  1199. * removed load_funcret
  1200. Revision 1.87 2003/04/25 20:59:33 peter
  1201. * removed funcretn,funcretsym, function result is now in varsym
  1202. and aliases for result and function name are added using absolutesym
  1203. * vs_hidden parameter for funcret passed in parameter
  1204. * vs_hidden fixes
  1205. * writenode changed to printnode and released from extdebug
  1206. * -vp option added to generate a tree.log with the nodetree
  1207. * nicer printnode for statements, callnode
  1208. Revision 1.86 2003/04/23 20:16:04 peter
  1209. + added currency support based on int64
  1210. + is_64bit for use in cg units instead of is_64bitint
  1211. * removed cgmessage from n386add, replace with internalerrors
  1212. Revision 1.85 2003/04/23 10:10:54 peter
  1213. * procvar is not compared in addrn
  1214. Revision 1.84 2003/04/22 23:50:23 peter
  1215. * firstpass uses expectloc
  1216. * checks if there are differences between the expectloc and
  1217. location.loc from secondpass in EXTDEBUG
  1218. Revision 1.83 2003/04/11 15:01:23 peter
  1219. * fix bug 2438
  1220. Revision 1.82 2003/03/28 19:16:56 peter
  1221. * generic constructor working for i386
  1222. * remove fixed self register
  1223. * esi added as address register for i386
  1224. Revision 1.81 2003/03/11 21:46:24 jonas
  1225. * lots of new regallocator fixes, both in generic and ppc-specific code
  1226. (ppc compiler still can't compile the linux system unit though)
  1227. Revision 1.80 2003/01/07 16:52:58 jonas
  1228. * fixed ansistring+char and ansistring+shortstring optimizations (those
  1229. cases were always handled as ansistring+ansistring due to
  1230. typeconversions inserted by the add-node)
  1231. Revision 1.79 2003/01/05 22:44:14 peter
  1232. * remove a lot of code to support typen in loadn-procsym
  1233. Revision 1.78 2003/01/03 12:15:56 daniel
  1234. * Removed ifdefs around notifications
  1235. ifdefs around for loop optimizations remain
  1236. Revision 1.77 2002/12/31 09:55:58 daniel
  1237. + Notification implementation complete
  1238. + Add for loop code optimization using notifications
  1239. results in 1.5-1.9% speed improvement in nestloop benchmark
  1240. Optimization incomplete, compiler does not cycle yet with
  1241. notifications enabled.
  1242. Revision 1.76 2002/12/30 22:44:53 daniel
  1243. * Some work on notifications
  1244. Revision 1.75 2002/12/27 15:27:25 peter
  1245. * remove property indicator when calling internal helpers
  1246. Revision 1.74 2002/12/24 16:53:19 peter
  1247. * fix for tb0438
  1248. Revision 1.73 2002/12/20 18:14:53 peter
  1249. * fix result of high_tree when high was not available
  1250. Revision 1.72 2002/12/17 22:19:33 peter
  1251. * fixed pushing of records>8 bytes with stdcall
  1252. * simplified hightree loading
  1253. Revision 1.71 2002/12/07 14:27:07 carl
  1254. * 3% memory optimization
  1255. * changed some types
  1256. + added type checking with different size for call node and for
  1257. parameters
  1258. Revision 1.70 2002/12/02 19:38:06 carl
  1259. * fix some errors
  1260. Revision 1.69 2002/11/29 20:02:44 carl
  1261. * warning / hint for possible loss of data in assignment
  1262. Revision 1.68 2002/11/27 20:04:39 peter
  1263. * cdecl array of const fixes
  1264. Revision 1.67 2002/11/27 15:33:47 peter
  1265. * the never ending story of tp procvar hacks
  1266. Revision 1.66 2002/11/25 17:43:20 peter
  1267. * splitted defbase in defutil,symutil,defcmp
  1268. * merged isconvertable and is_equal into compare_defs(_ext)
  1269. * made operator search faster by walking the list only once
  1270. Revision 1.65 2002/11/18 17:31:57 peter
  1271. * pass proccalloption to ret_in_xxx and push_xxx functions
  1272. Revision 1.64 2002/11/15 01:58:52 peter
  1273. * merged changes from 1.0.7 up to 04-11
  1274. - -V option for generating bug report tracing
  1275. - more tracing for option parsing
  1276. - errors for cdecl and high()
  1277. - win32 import stabs
  1278. - win32 records<=8 are returned in eax:edx (turned off by default)
  1279. - heaptrc update
  1280. - more info for temp management in .s file with EXTDEBUG
  1281. Revision 1.63 2002/10/17 12:44:09 florian
  1282. + s:=s+<string type> where s is an ansistring is done via calls to append_ansistring_*
  1283. Revision 1.62 2002/10/05 12:43:25 carl
  1284. * fixes for Delphi 6 compilation
  1285. (warning : Some features do not work under Delphi)
  1286. Revision 1.61 2002/10/03 21:26:08 carl
  1287. + compile-time range checking for strings
  1288. Revision 1.60 2002/09/27 21:13:28 carl
  1289. * low-highval always checked if limit ober 2GB is reached (to avoid overflow)
  1290. Revision 1.59 2002/09/26 15:02:05 florian
  1291. + support of passing variants to "array of const"
  1292. Revision 1.58 2002/09/07 15:25:03 peter
  1293. * old logs removed and tabs fixed
  1294. Revision 1.57 2002/09/03 16:26:26 daniel
  1295. * Make Tprocdef.defs protected
  1296. Revision 1.56 2002/09/01 13:28:37 daniel
  1297. - write_access fields removed in favor of a flag
  1298. Revision 1.55 2002/09/01 08:01:16 daniel
  1299. * Removed sets from Tcallnode.det_resulttype
  1300. + Added read/write notifications of variables. These will be usefull
  1301. for providing information for several optimizations. For example
  1302. the value of the loop variable of a for loop does matter is the
  1303. variable is read after the for loop, but if it's no longer used
  1304. or written, it doesn't matter and this can be used to optimize
  1305. the loop code generation.
  1306. Revision 1.54 2002/08/25 19:25:19 peter
  1307. * sym.insert_in_data removed
  1308. * symtable.insertvardata/insertconstdata added
  1309. * removed insert_in_data call from symtable.insert, it needs to be
  1310. called separatly. This allows to deref the address calculation
  1311. * procedures now calculate the parast addresses after the procedure
  1312. directives are parsed. This fixes the cdecl parast problem
  1313. * push_addr_param has an extra argument that specifies if cdecl is used
  1314. or not
  1315. Revision 1.53 2002/08/19 19:36:43 peter
  1316. * More fixes for cross unit inlining, all tnodes are now implemented
  1317. * Moved pocall_internconst to po_internconst because it is not a
  1318. calling type at all and it conflicted when inlining of these small
  1319. functions was requested
  1320. Revision 1.52 2002/08/18 20:06:23 peter
  1321. * inlining is now also allowed in interface
  1322. * renamed write/load to ppuwrite/ppuload
  1323. * tnode storing in ppu
  1324. * nld,ncon,nbas are already updated for storing in ppu
  1325. Revision 1.51 2002/08/17 22:09:46 florian
  1326. * result type handling in tcgcal.pass_2 overhauled
  1327. * better tnode.dowrite
  1328. * some ppc stuff fixed
  1329. Revision 1.50 2002/08/17 09:23:37 florian
  1330. * first part of procinfo rewrite
  1331. Revision 1.49 2002/07/20 11:57:54 florian
  1332. * types.pas renamed to defbase.pas because D6 contains a types
  1333. unit so this would conflicts if D6 programms are compiled
  1334. + Willamette/SSE2 instructions to assembler added
  1335. Revision 1.48 2002/07/20 07:44:37 daniel
  1336. * Forgot to add a $ifdef extdebug
  1337. Revision 1.47 2002/07/19 12:55:27 daniel
  1338. * Further developed state tracking in whilerepeatn
  1339. Revision 1.46 2002/07/19 11:41:36 daniel
  1340. * State tracker work
  1341. * The whilen and repeatn are now completely unified into whilerepeatn. This
  1342. allows the state tracker to change while nodes automatically into
  1343. repeat nodes.
  1344. * Resulttypepass improvements to the notn. 'not not a' is optimized away and
  1345. 'not(a>b)' is optimized into 'a<=b'.
  1346. * Resulttypepass improvements to the whilerepeatn. 'while not a' is optimized
  1347. by removing the notn and later switchting the true and falselabels. The
  1348. same is done with 'repeat until not a'.
  1349. Revision 1.45 2002/07/15 18:03:15 florian
  1350. * readded removed changes
  1351. Revision 1.43 2002/07/11 14:41:28 florian
  1352. * start of the new generic parameter handling
  1353. Revision 1.44 2002/07/14 18:00:44 daniel
  1354. + Added the beginning of a state tracker. This will track the values of
  1355. variables through procedures and optimize things away.
  1356. Revision 1.42 2002/05/18 13:34:10 peter
  1357. * readded missing revisions
  1358. Revision 1.41 2002/05/16 19:46:38 carl
  1359. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  1360. + try to fix temp allocation (still in ifdef)
  1361. + generic constructor calls
  1362. + start of tassembler / tmodulebase class cleanup
  1363. Revision 1.39 2002/05/12 16:53:07 peter
  1364. * moved entry and exitcode to ncgutil and cgobj
  1365. * foreach gets extra argument for passing local data to the
  1366. iterator function
  1367. * -CR checks also class typecasts at runtime by changing them
  1368. into as
  1369. * fixed compiler to cycle with the -CR option
  1370. * fixed stabs with elf writer, finally the global variables can
  1371. be watched
  1372. * removed a lot of routines from cga unit and replaced them by
  1373. calls to cgobj
  1374. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  1375. u32bit then the other is typecasted also to u32bit without giving
  1376. a rangecheck warning/error.
  1377. * fixed pascal calling method with reversing also the high tree in
  1378. the parast, detected by tcalcst3 test
  1379. Revision 1.38 2002/04/25 20:16:39 peter
  1380. * moved more routines from cga/n386util
  1381. Revision 1.37 2002/04/23 19:16:34 peter
  1382. * add pinline unit that inserts compiler supported functions using
  1383. one or more statements
  1384. * moved finalize and setlength from ninl to pinline
  1385. }