nld.pas 56 KB

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