nld.pas 55 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609
  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. procedure insert_typeconvs;
  78. end;
  79. tarrayconstructornodeclass = class of tarrayconstructornode;
  80. ttypenode = class(tnode)
  81. allowed : boolean;
  82. restype : ttype;
  83. constructor create(t : ttype);virtual;
  84. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  85. procedure ppuwrite(ppufile:tcompilerppufile);override;
  86. procedure derefimpl;override;
  87. function pass_1 : tnode;override;
  88. function det_resulttype:tnode;override;
  89. function docompare(p: tnode): boolean; override;
  90. end;
  91. ttypenodeclass = class of ttypenode;
  92. trttinode = class(tnode)
  93. l1,l2 : longint;
  94. rttitype : trttitype;
  95. rttidef : tstoreddef;
  96. rttidefderef : tderef;
  97. constructor create(def:tstoreddef;rt:trttitype);virtual;
  98. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  99. procedure ppuwrite(ppufile:tcompilerppufile);override;
  100. procedure derefimpl;override;
  101. function getcopy : tnode;override;
  102. function pass_1 : tnode;override;
  103. procedure pass_2;override;
  104. function det_resulttype:tnode;override;
  105. function docompare(p: tnode): boolean; override;
  106. end;
  107. trttinodeclass = class of trttinode;
  108. var
  109. cloadnode : tloadnodeclass;
  110. cassignmentnode : tassignmentnodeclass;
  111. carrayconstructorrangenode : tarrayconstructorrangenodeclass;
  112. carrayconstructornode : tarrayconstructornodeclass;
  113. ctypenode : ttypenodeclass;
  114. crttinode : trttinodeclass;
  115. procedure load_procvar_from_calln(var p1:tnode);
  116. function load_high_value_node(vs:tvarsym):tnode;
  117. function load_self_node:tnode;
  118. function load_result_node:tnode;
  119. function load_self_pointer_node:tnode;
  120. function load_vmt_pointer_node:tnode;
  121. function is_self_node(p:tnode):boolean;
  122. implementation
  123. uses
  124. cutils,verbose,globtype,globals,systems,
  125. symtable,symnot,
  126. defutil,defcmp,
  127. htypechk,pass_1,procinfo,paramgr,
  128. ncon,ninl,ncnv,nmem,ncal,cpubase,cgobj,cgbase
  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 cg.t_times>1 then
  436. inc(tvarsym(symtableentry).refs,cg.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,vs_assigned,false);
  580. set_varstate(right,vs_used,true);
  581. if codegenerror then
  582. exit;
  583. { assignments to formaldefs and open arrays aren't allowed }
  584. if (left.resulttype.def.deftype=formaldef) or
  585. is_open_array(left.resulttype.def) then
  586. CGMessage(type_e_operator_not_allowed);
  587. { test if node can be assigned, properties are allowed }
  588. valid_for_assignment(left);
  589. { assigning nil to a dynamic array clears the array }
  590. if is_dynamic_array(left.resulttype.def) and
  591. (right.nodetype=niln) then
  592. begin
  593. hp:=ccallparanode.create(caddrnode.create
  594. (crttinode.create(tstoreddef(left.resulttype.def),initrtti)),
  595. ccallparanode.create(ctypeconvnode.create_explicit(left,voidpointertype),nil));
  596. result := ccallnode.createintern('fpc_dynarray_clear',hp);
  597. left:=nil;
  598. exit;
  599. end;
  600. { shortstring helpers can do the conversion directly,
  601. so treat them separatly }
  602. if (is_shortstring(left.resulttype.def)) then
  603. begin
  604. { insert typeconv, except for chars that are handled in
  605. secondpass and except for ansi/wide string that can
  606. be converted immediatly }
  607. if not(is_char(right.resulttype.def) or
  608. (right.resulttype.def.deftype=stringdef)) then
  609. inserttypeconv(right,left.resulttype);
  610. if right.resulttype.def.deftype=stringdef then
  611. begin
  612. useshelper:=true;
  613. { convert constant strings to shortstrings. But
  614. skip empty constant strings, that will be handled
  615. in secondpass }
  616. if (right.nodetype=stringconstn) then
  617. begin
  618. { verify if range fits within shortstring }
  619. { just emit a warning, delphi gives an }
  620. { error, only if the type definition of }
  621. { of the string is less < 255 characters }
  622. if not is_open_string(left.resulttype.def) and
  623. (tstringconstnode(right).len > tstringdef(left.resulttype.def).len) then
  624. cgmessage(type_w_string_too_long);
  625. inserttypeconv(right,left.resulttype);
  626. if (tstringconstnode(right).len=0) then
  627. useshelper:=false;
  628. end;
  629. { rest is done in pass 1 (JM) }
  630. if useshelper then
  631. exit;
  632. end
  633. end
  634. else
  635. begin
  636. { get the size before the type conversion - check for all nodes }
  637. if assigned(right.resulttype.def) and
  638. (right.resulttype.def.deftype in [enumdef,orddef,floatdef]) and
  639. (right.nodetype in [loadn,vecn,calln]) then
  640. original_size := right.resulttype.def.size;
  641. inserttypeconv(right,left.resulttype);
  642. end;
  643. { check if the assignment may cause a range check error }
  644. { if its not explicit, and only if the values are }
  645. { ordinals, enumdef and floatdef }
  646. if (right.nodetype = typeconvn) and
  647. not (nf_explicit in ttypeconvnode(right).flags) then
  648. begin
  649. if assigned(left.resulttype.def) and
  650. (left.resulttype.def.deftype in [enumdef,orddef,floatdef]) then
  651. begin
  652. if (original_size <> 0) and (left.resulttype.def.size < original_size) then
  653. begin
  654. if (cs_check_range in aktlocalswitches) then
  655. Message(type_w_smaller_possible_range_check)
  656. else
  657. Message(type_h_smaller_possible_range_check);
  658. end;
  659. end;
  660. end;
  661. { call helpers for interface }
  662. if is_interfacecom(left.resulttype.def) then
  663. begin
  664. hp:=ccallparanode.create(ctypeconvnode.create_explicit
  665. (right,voidpointertype),
  666. ccallparanode.create(ctypeconvnode.create_explicit
  667. (left,voidpointertype),nil));
  668. result:=ccallnode.createintern('fpc_intf_assign',hp);
  669. left:=nil;
  670. right:=nil;
  671. exit;
  672. end;
  673. { check if local proc/func is assigned to procvar }
  674. if right.resulttype.def.deftype=procvardef then
  675. test_local_to_procvar(tprocvardef(right.resulttype.def),left.resulttype.def);
  676. end;
  677. function tassignmentnode.pass_1 : tnode;
  678. var
  679. hp: tnode;
  680. begin
  681. result:=nil;
  682. expectloc:=LOC_VOID;
  683. firstpass(left);
  684. firstpass(right);
  685. { assignment to refcounted variable -> inc/decref }
  686. if (not is_class(left.resulttype.def) and
  687. left.resulttype.def.needs_inittable) then
  688. include(current_procinfo.flags,pi_do_call);
  689. if codegenerror then
  690. exit;
  691. if (is_shortstring(left.resulttype.def)) then
  692. begin
  693. if right.resulttype.def.deftype=stringdef then
  694. begin
  695. if (right.nodetype<>stringconstn) or
  696. (tstringconstnode(right).len<>0) then
  697. begin
  698. if (cs_optimize in aktglobalswitches) and
  699. (right.nodetype in [calln,blockn]) and
  700. (left.nodetype = temprefn) and
  701. is_shortstring(right.resulttype.def) and
  702. not is_open_string(left.resulttype.def) and
  703. (tstringdef(left.resulttype.def).len = 255) then
  704. begin
  705. { the blocknode case is handled in pass_2 at the temp }
  706. { reference level (mainly for callparatemp) (JM) }
  707. if (right.nodetype = calln) then
  708. begin
  709. tcallnode(right).funcretnode := left;
  710. result := right;
  711. end
  712. else
  713. exit;
  714. end
  715. else
  716. begin
  717. hp:=ccallparanode.create
  718. (right,
  719. ccallparanode.create(cinlinenode.create
  720. (in_high_x,false,left.getcopy),nil));
  721. result:=ccallnode.createinternreturn('fpc_'+tstringdef(right.resulttype.def).stringtypname+'_to_shortstr',hp,left);
  722. firstpass(result);
  723. end;
  724. left:=nil;
  725. right:=nil;
  726. exit;
  727. end;
  728. end;
  729. end;
  730. if (cs_optimize in aktglobalswitches) and
  731. (right.nodetype = calln) and
  732. { left must be a temp, since otherwise as soon as you modify the }
  733. { result, the current left node is modified and that one may }
  734. { still be an argument to the function or even accessed in the }
  735. { function }
  736. (((left.nodetype = temprefn) and
  737. paramanager.ret_in_param(right.resulttype.def,
  738. tcallnode(right).procdefinition.proccalloption)) or
  739. { there's special support for ansi/widestrings in the callnode }
  740. is_ansistring(right.resulttype.def) or
  741. is_widestring(right.resulttype.def)) then
  742. begin
  743. tcallnode(right).funcretnode := left;
  744. result := right;
  745. left := nil;
  746. right := nil;
  747. exit;
  748. end;
  749. registers32:=left.registers32+right.registers32;
  750. registersfpu:=max(left.registersfpu,right.registersfpu);
  751. {$ifdef SUPPORT_MMX}
  752. registersmmx:=max(left.registersmmx,right.registersmmx);
  753. {$endif SUPPORT_MMX}
  754. end;
  755. function tassignmentnode.docompare(p: tnode): boolean;
  756. begin
  757. docompare :=
  758. inherited docompare(p) and
  759. (assigntype = tassignmentnode(p).assigntype);
  760. end;
  761. {$ifdef state_tracking}
  762. function Tassignmentnode.track_state_pass(exec_known:boolean):boolean;
  763. var se:Tstate_entry;
  764. begin
  765. track_state_pass:=false;
  766. if exec_known then
  767. begin
  768. track_state_pass:=right.track_state_pass(exec_known);
  769. {Force a new resulttype pass.}
  770. right.resulttype.def:=nil;
  771. do_resulttypepass(right);
  772. resulttypepass(right);
  773. aktstate.store_fact(left.getcopy,right.getcopy);
  774. end
  775. else
  776. aktstate.delete_fact(left);
  777. end;
  778. {$endif}
  779. {*****************************************************************************
  780. TARRAYCONSTRUCTORRANGENODE
  781. *****************************************************************************}
  782. constructor tarrayconstructorrangenode.create(l,r : tnode);
  783. begin
  784. inherited create(arrayconstructorrangen,l,r);
  785. end;
  786. function tarrayconstructorrangenode.det_resulttype:tnode;
  787. begin
  788. result:=nil;
  789. resulttypepass(left);
  790. resulttypepass(right);
  791. set_varstate(left,vs_used,true);
  792. set_varstate(right,vs_used,true);
  793. if codegenerror then
  794. exit;
  795. resulttype:=left.resulttype;
  796. end;
  797. function tarrayconstructorrangenode.pass_1 : tnode;
  798. begin
  799. firstpass(left);
  800. firstpass(right);
  801. expectloc:=LOC_CREFERENCE;
  802. calcregisters(self,0,0,0);
  803. result:=nil;
  804. end;
  805. {****************************************************************************
  806. TARRAYCONSTRUCTORNODE
  807. *****************************************************************************}
  808. constructor tarrayconstructornode.create(l,r : tnode);
  809. begin
  810. inherited create(arrayconstructorn,l,r);
  811. end;
  812. function tarrayconstructornode.getcopy : tnode;
  813. var
  814. n : tarrayconstructornode;
  815. begin
  816. n:=tarrayconstructornode(inherited getcopy);
  817. result:=n;
  818. end;
  819. function tarrayconstructornode.det_resulttype:tnode;
  820. var
  821. htype : ttype;
  822. hp : tarrayconstructornode;
  823. len : longint;
  824. varia : boolean;
  825. begin
  826. result:=nil;
  827. { are we allowing array constructor? Then convert it to a set }
  828. if not allow_array_constructor then
  829. begin
  830. hp:=tarrayconstructornode(getcopy);
  831. arrayconstructor_to_set(tnode(hp));
  832. result:=hp;
  833. exit;
  834. end;
  835. { only pass left tree, right tree contains next construct if any }
  836. htype.reset;
  837. len:=0;
  838. varia:=false;
  839. if assigned(left) then
  840. begin
  841. hp:=self;
  842. while assigned(hp) do
  843. begin
  844. resulttypepass(hp.left);
  845. set_varstate(hp.left,vs_used,true);
  846. if (htype.def=nil) then
  847. htype:=hp.left.resulttype
  848. else
  849. begin
  850. if ((nf_novariaallowed in flags) or (not varia)) and
  851. (not equal_defs(htype.def,hp.left.resulttype.def)) then
  852. begin
  853. varia:=true;
  854. end;
  855. end;
  856. inc(len);
  857. hp:=tarrayconstructornode(hp.right);
  858. end;
  859. end;
  860. if not assigned(htype.def) then
  861. htype:=voidtype;
  862. resulttype.setdef(tarraydef.create(0,len-1,s32bittype));
  863. tarraydef(resulttype.def).setelementtype(htype);
  864. tarraydef(resulttype.def).IsConstructor:=true;
  865. tarraydef(resulttype.def).IsVariant:=varia;
  866. end;
  867. procedure tarrayconstructornode.force_type(tt:ttype);
  868. var
  869. hp : tarrayconstructornode;
  870. begin
  871. tarraydef(resulttype.def).setelementtype(tt);
  872. tarraydef(resulttype.def).IsConstructor:=true;
  873. tarraydef(resulttype.def).IsVariant:=false;
  874. if assigned(left) then
  875. begin
  876. hp:=self;
  877. while assigned(hp) do
  878. begin
  879. inserttypeconv(hp.left,tt);
  880. hp:=tarrayconstructornode(hp.right);
  881. end;
  882. end;
  883. end;
  884. procedure tarrayconstructornode.insert_typeconvs;
  885. var
  886. thp,
  887. chp,
  888. hp : tarrayconstructornode;
  889. dovariant : boolean;
  890. htype : ttype;
  891. orgflags : tnodeflags;
  892. begin
  893. dovariant:=(nf_forcevaria in flags) or tarraydef(resulttype.def).isvariant;
  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. resulttypepass(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. hp.left:=ctypeconvnode.create_explicit(hp.left,s32bittype);
  907. arraydef :
  908. hp.left:=ctypeconvnode.create(hp.left,charpointertype);
  909. orddef :
  910. begin
  911. if is_integer(hp.left.resulttype.def) and
  912. not(is_64bitint(hp.left.resulttype.def)) then
  913. hp.left:=ctypeconvnode.create(hp.left,s32bittype);
  914. end;
  915. floatdef :
  916. begin
  917. { C uses 64bit floats }
  918. if nf_cargs in flags then
  919. hp.left:=ctypeconvnode.create(hp.left,s64floattype)
  920. else
  921. hp.left:=ctypeconvnode.create(hp.left,pbestrealtype^);
  922. end;
  923. stringdef :
  924. begin
  925. if nf_cargs in flags then
  926. hp.left:=ctypeconvnode.create(hp.left,charpointertype);
  927. end;
  928. procvardef :
  929. hp.left:=ctypeconvnode.create(hp.left,voidpointertype);
  930. variantdef,
  931. pointerdef,
  932. classrefdef,
  933. objectdef : ;
  934. else
  935. CGMessagePos1(hp.left.fileinfo,type_e_wrong_type_in_array_constructor,hp.left.resulttype.def.typename);
  936. end;
  937. end;
  938. resulttypepass(hp.left);
  939. hp:=tarrayconstructornode(hp.right);
  940. end;
  941. end;
  942. end;
  943. function tarrayconstructornode.pass_1 : tnode;
  944. var
  945. hp : tarrayconstructornode;
  946. begin
  947. result:=nil;
  948. { Insert required type convs, this must be
  949. done in pass 1, because the call must be
  950. resulttypepassed already }
  951. if assigned(left) then
  952. begin
  953. insert_typeconvs;
  954. { call firstpass for all nodes }
  955. hp:=self;
  956. while assigned(hp) do
  957. begin
  958. firstpass(hp.left);
  959. hp:=tarrayconstructornode(hp.right);
  960. end;
  961. end;
  962. expectloc:=LOC_CREFERENCE;
  963. calcregisters(self,0,0,0);
  964. end;
  965. function tarrayconstructornode.docompare(p: tnode): boolean;
  966. begin
  967. docompare :=
  968. inherited docompare(p);
  969. end;
  970. {*****************************************************************************
  971. TTYPENODE
  972. *****************************************************************************}
  973. constructor ttypenode.create(t : ttype);
  974. begin
  975. inherited create(typen);
  976. restype:=t;
  977. allowed:=false;
  978. end;
  979. constructor ttypenode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  980. begin
  981. inherited ppuload(t,ppufile);
  982. ppufile.gettype(restype);
  983. allowed:=boolean(ppufile.getbyte);
  984. end;
  985. procedure ttypenode.ppuwrite(ppufile:tcompilerppufile);
  986. begin
  987. inherited ppuwrite(ppufile);
  988. ppufile.puttype(restype);
  989. ppufile.putbyte(byte(allowed));
  990. end;
  991. procedure ttypenode.derefimpl;
  992. begin
  993. inherited derefimpl;
  994. restype.resolve;
  995. end;
  996. function ttypenode.det_resulttype:tnode;
  997. begin
  998. result:=nil;
  999. resulttype:=restype;
  1000. { check if it's valid }
  1001. if restype.def.deftype = errordef then
  1002. CGMessage(cg_e_illegal_expression);
  1003. end;
  1004. function ttypenode.pass_1 : tnode;
  1005. begin
  1006. result:=nil;
  1007. expectloc:=LOC_VOID;
  1008. { a typenode can't generate code, so we give here
  1009. an error. Else it'll be an abstract error in pass_2.
  1010. Only when the allowed flag is set we don't generate
  1011. an error }
  1012. if not allowed then
  1013. Message(parser_e_no_type_not_allowed_here);
  1014. end;
  1015. function ttypenode.docompare(p: tnode): boolean;
  1016. begin
  1017. docompare :=
  1018. inherited docompare(p);
  1019. end;
  1020. {*****************************************************************************
  1021. TRTTINODE
  1022. *****************************************************************************}
  1023. constructor trttinode.create(def:tstoreddef;rt:trttitype);
  1024. begin
  1025. inherited create(rttin);
  1026. rttidef:=def;
  1027. rttitype:=rt;
  1028. end;
  1029. constructor trttinode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  1030. begin
  1031. inherited ppuload(t,ppufile);
  1032. ppufile.getderef(rttidefderef);
  1033. rttitype:=trttitype(ppufile.getbyte);
  1034. end;
  1035. procedure trttinode.ppuwrite(ppufile:tcompilerppufile);
  1036. begin
  1037. inherited ppuwrite(ppufile);
  1038. ppufile.putderef(rttidef,rttidefderef);
  1039. ppufile.putbyte(byte(rttitype));
  1040. end;
  1041. procedure trttinode.derefimpl;
  1042. begin
  1043. inherited derefimpl;
  1044. rttidef:=tstoreddef(rttidefderef.resolve);
  1045. end;
  1046. function trttinode.getcopy : tnode;
  1047. var
  1048. n : trttinode;
  1049. begin
  1050. n:=trttinode(inherited getcopy);
  1051. n.rttidef:=rttidef;
  1052. n.rttitype:=rttitype;
  1053. result:=n;
  1054. end;
  1055. function trttinode.det_resulttype:tnode;
  1056. begin
  1057. { rtti information will be returned as a void pointer }
  1058. result:=nil;
  1059. resulttype:=voidpointertype;
  1060. end;
  1061. function trttinode.pass_1 : tnode;
  1062. begin
  1063. result:=nil;
  1064. expectloc:=LOC_CREFERENCE;
  1065. end;
  1066. function trttinode.docompare(p: tnode): boolean;
  1067. begin
  1068. docompare :=
  1069. inherited docompare(p) and
  1070. (rttidef = trttinode(p).rttidef) and
  1071. (rttitype = trttinode(p).rttitype);
  1072. end;
  1073. procedure trttinode.pass_2;
  1074. begin
  1075. location_reset(location,LOC_CREFERENCE,OS_NO);
  1076. location.reference.symbol:=rttidef.get_rtti_label(rttitype);
  1077. end;
  1078. begin
  1079. cloadnode:=tloadnode;
  1080. cassignmentnode:=tassignmentnode;
  1081. carrayconstructorrangenode:=tarrayconstructorrangenode;
  1082. carrayconstructornode:=tarrayconstructornode;
  1083. ctypenode:=ttypenode;
  1084. crttinode:=trttinode;
  1085. end.
  1086. {
  1087. $Log$
  1088. Revision 1.113 2003-10-17 14:38:32 peter
  1089. * 64k registers supported
  1090. * fixed some memory leaks
  1091. Revision 1.112 2003/10/10 17:48:13 peter
  1092. * old trgobj moved to x86/rgcpu and renamed to trgx86fpu
  1093. * tregisteralloctor renamed to trgobj
  1094. * removed rgobj from a lot of units
  1095. * moved location_* and reference_* to cgobj
  1096. * first things for mmx register allocation
  1097. Revision 1.111 2003/10/09 21:31:37 daniel
  1098. * Register allocator splitted, ans abstract now
  1099. Revision 1.110 2003/10/08 19:19:45 peter
  1100. * set_varstate cleanup
  1101. Revision 1.109 2003/10/05 21:21:52 peter
  1102. * c style array of const generates callparanodes
  1103. * varargs paraloc fixes
  1104. Revision 1.108 2003/10/01 20:34:48 peter
  1105. * procinfo unit contains tprocinfo
  1106. * cginfo renamed to cgbase
  1107. * moved cgmessage to verbose
  1108. * fixed ppc and sparc compiles
  1109. Revision 1.107 2003/09/28 17:55:03 peter
  1110. * parent framepointer changed to hidden parameter
  1111. * tloadparentfpnode added
  1112. Revision 1.106 2003/09/23 17:56:05 peter
  1113. * locals and paras are allocated in the code generation
  1114. * tvarsym.localloc contains the location of para/local when
  1115. generating code for the current procedure
  1116. Revision 1.105 2003/09/16 16:17:01 peter
  1117. * varspez in calls to push_addr_param
  1118. Revision 1.104 2003/09/07 22:09:35 peter
  1119. * preparations for different default calling conventions
  1120. * various RA fixes
  1121. Revision 1.103 2003/07/08 15:20:56 peter
  1122. * don't allow add/assignments for formaldef
  1123. * formaldef size changed to 0
  1124. Revision 1.102 2003/06/13 21:19:30 peter
  1125. * current_procdef removed, use current_procinfo.procdef instead
  1126. Revision 1.101 2003/06/08 20:01:53 jonas
  1127. * optimized assignments with on the right side a function that returns
  1128. an ansi- or widestring
  1129. Revision 1.100 2003/06/08 18:27:15 jonas
  1130. + ability to change the location of a ttempref node with changelocation()
  1131. method. Useful to use instead of copying the contents from one temp to
  1132. another
  1133. + some shortstring optimizations in tassignmentnode that avoid some
  1134. copying (required some shortstring optimizations to be moved from
  1135. resulttype to firstpass, because they work on callnodes and string
  1136. addnodes are only changed to callnodes in the firstpass)
  1137. * allow setting/changing the funcretnode of callnodes after the
  1138. resulttypepass has been done, funcretnode is now a property
  1139. (all of the above should have a quite big effect on callparatemp)
  1140. Revision 1.99 2003/06/07 20:26:32 peter
  1141. * re-resolving added instead of reloading from ppu
  1142. * tderef object added to store deref info for resolving
  1143. Revision 1.98 2003/06/07 18:57:04 jonas
  1144. + added freeintparaloc
  1145. * ppc get/freeintparaloc now check whether the parameter regs are
  1146. properly allocated/deallocated (and get an extra list para)
  1147. * ppc a_call_* now internalerrors if pi_do_call is not yet set
  1148. * fixed lot of missing pi_do_call's
  1149. Revision 1.97 2003/06/07 14:39:18 jonas
  1150. * set pi_do_call for accesses to threadvars
  1151. Revision 1.96 2003/05/26 19:38:28 peter
  1152. * generic fpc_shorstr_concat
  1153. + fpc_shortstr_append_shortstr optimization
  1154. Revision 1.95 2003/05/23 17:05:13 peter
  1155. * loadn procsym need to return procdef
  1156. Revision 1.94 2003/05/23 14:27:35 peter
  1157. * remove some unit dependencies
  1158. * current_procinfo changes to store more info
  1159. Revision 1.93 2003/05/11 21:37:03 peter
  1160. * moved implicit exception frame from ncgutil to psub
  1161. * constructor/destructor helpers moved from cobj/ncgutil to psub
  1162. Revision 1.92 2003/05/11 14:45:12 peter
  1163. * tloadnode does not support objectsymtable,withsymtable anymore
  1164. * withnode cleanup
  1165. * direct with rewritten to use temprefnode
  1166. Revision 1.91 2003/05/09 17:47:02 peter
  1167. * self moved to hidden parameter
  1168. * removed hdisposen,hnewn,selfn
  1169. Revision 1.90 2003/04/27 11:21:33 peter
  1170. * aktprocdef renamed to current_procinfo.procdef
  1171. * procinfo renamed to current_procinfo
  1172. * procinfo will now be stored in current_module so it can be
  1173. cleaned up properly
  1174. * gen_main_procsym changed to create_main_proc and release_main_proc
  1175. to also generate a tprocinfo structure
  1176. * fixed unit implicit initfinal
  1177. Revision 1.89 2003/04/27 07:29:50 peter
  1178. * current_procinfo.procdef cleanup, current_procdef is now always nil when parsing
  1179. a new procdef declaration
  1180. * aktprocsym removed
  1181. * lexlevel removed, use symtable.symtablelevel instead
  1182. * implicit init/final code uses the normal genentry/genexit
  1183. * funcret state checking updated for new funcret handling
  1184. Revision 1.88 2003/04/26 00:28:42 peter
  1185. * removed load_funcret
  1186. Revision 1.87 2003/04/25 20:59:33 peter
  1187. * removed funcretn,funcretsym, function result is now in varsym
  1188. and aliases for result and function name are added using absolutesym
  1189. * vs_hidden parameter for funcret passed in parameter
  1190. * vs_hidden fixes
  1191. * writenode changed to printnode and released from extdebug
  1192. * -vp option added to generate a tree.log with the nodetree
  1193. * nicer printnode for statements, callnode
  1194. Revision 1.86 2003/04/23 20:16:04 peter
  1195. + added currency support based on int64
  1196. + is_64bit for use in cg units instead of is_64bitint
  1197. * removed cgmessage from n386add, replace with internalerrors
  1198. Revision 1.85 2003/04/23 10:10:54 peter
  1199. * procvar is not compared in addrn
  1200. Revision 1.84 2003/04/22 23:50:23 peter
  1201. * firstpass uses expectloc
  1202. * checks if there are differences between the expectloc and
  1203. location.loc from secondpass in EXTDEBUG
  1204. Revision 1.83 2003/04/11 15:01:23 peter
  1205. * fix bug 2438
  1206. Revision 1.82 2003/03/28 19:16:56 peter
  1207. * generic constructor working for i386
  1208. * remove fixed self register
  1209. * esi added as address register for i386
  1210. Revision 1.81 2003/03/11 21:46:24 jonas
  1211. * lots of new regallocator fixes, both in generic and ppc-specific code
  1212. (ppc compiler still can't compile the linux system unit though)
  1213. Revision 1.80 2003/01/07 16:52:58 jonas
  1214. * fixed ansistring+char and ansistring+shortstring optimizations (those
  1215. cases were always handled as ansistring+ansistring due to
  1216. typeconversions inserted by the add-node)
  1217. Revision 1.79 2003/01/05 22:44:14 peter
  1218. * remove a lot of code to support typen in loadn-procsym
  1219. Revision 1.78 2003/01/03 12:15:56 daniel
  1220. * Removed ifdefs around notifications
  1221. ifdefs around for loop optimizations remain
  1222. Revision 1.77 2002/12/31 09:55:58 daniel
  1223. + Notification implementation complete
  1224. + Add for loop code optimization using notifications
  1225. results in 1.5-1.9% speed improvement in nestloop benchmark
  1226. Optimization incomplete, compiler does not cycle yet with
  1227. notifications enabled.
  1228. Revision 1.76 2002/12/30 22:44:53 daniel
  1229. * Some work on notifications
  1230. Revision 1.75 2002/12/27 15:27:25 peter
  1231. * remove property indicator when calling internal helpers
  1232. Revision 1.74 2002/12/24 16:53:19 peter
  1233. * fix for tb0438
  1234. Revision 1.73 2002/12/20 18:14:53 peter
  1235. * fix result of high_tree when high was not available
  1236. Revision 1.72 2002/12/17 22:19:33 peter
  1237. * fixed pushing of records>8 bytes with stdcall
  1238. * simplified hightree loading
  1239. Revision 1.71 2002/12/07 14:27:07 carl
  1240. * 3% memory optimization
  1241. * changed some types
  1242. + added type checking with different size for call node and for
  1243. parameters
  1244. Revision 1.70 2002/12/02 19:38:06 carl
  1245. * fix some errors
  1246. Revision 1.69 2002/11/29 20:02:44 carl
  1247. * warning / hint for possible loss of data in assignment
  1248. Revision 1.68 2002/11/27 20:04:39 peter
  1249. * cdecl array of const fixes
  1250. Revision 1.67 2002/11/27 15:33:47 peter
  1251. * the never ending story of tp procvar hacks
  1252. Revision 1.66 2002/11/25 17:43:20 peter
  1253. * splitted defbase in defutil,symutil,defcmp
  1254. * merged isconvertable and is_equal into compare_defs(_ext)
  1255. * made operator search faster by walking the list only once
  1256. Revision 1.65 2002/11/18 17:31:57 peter
  1257. * pass proccalloption to ret_in_xxx and push_xxx functions
  1258. Revision 1.64 2002/11/15 01:58:52 peter
  1259. * merged changes from 1.0.7 up to 04-11
  1260. - -V option for generating bug report tracing
  1261. - more tracing for option parsing
  1262. - errors for cdecl and high()
  1263. - win32 import stabs
  1264. - win32 records<=8 are returned in eax:edx (turned off by default)
  1265. - heaptrc update
  1266. - more info for temp management in .s file with EXTDEBUG
  1267. Revision 1.63 2002/10/17 12:44:09 florian
  1268. + s:=s+<string type> where s is an ansistring is done via calls to append_ansistring_*
  1269. Revision 1.62 2002/10/05 12:43:25 carl
  1270. * fixes for Delphi 6 compilation
  1271. (warning : Some features do not work under Delphi)
  1272. Revision 1.61 2002/10/03 21:26:08 carl
  1273. + compile-time range checking for strings
  1274. Revision 1.60 2002/09/27 21:13:28 carl
  1275. * low-highval always checked if limit ober 2GB is reached (to avoid overflow)
  1276. Revision 1.59 2002/09/26 15:02:05 florian
  1277. + support of passing variants to "array of const"
  1278. Revision 1.58 2002/09/07 15:25:03 peter
  1279. * old logs removed and tabs fixed
  1280. Revision 1.57 2002/09/03 16:26:26 daniel
  1281. * Make Tprocdef.defs protected
  1282. Revision 1.56 2002/09/01 13:28:37 daniel
  1283. - write_access fields removed in favor of a flag
  1284. Revision 1.55 2002/09/01 08:01:16 daniel
  1285. * Removed sets from Tcallnode.det_resulttype
  1286. + Added read/write notifications of variables. These will be usefull
  1287. for providing information for several optimizations. For example
  1288. the value of the loop variable of a for loop does matter is the
  1289. variable is read after the for loop, but if it's no longer used
  1290. or written, it doesn't matter and this can be used to optimize
  1291. the loop code generation.
  1292. Revision 1.54 2002/08/25 19:25:19 peter
  1293. * sym.insert_in_data removed
  1294. * symtable.insertvardata/insertconstdata added
  1295. * removed insert_in_data call from symtable.insert, it needs to be
  1296. called separatly. This allows to deref the address calculation
  1297. * procedures now calculate the parast addresses after the procedure
  1298. directives are parsed. This fixes the cdecl parast problem
  1299. * push_addr_param has an extra argument that specifies if cdecl is used
  1300. or not
  1301. Revision 1.53 2002/08/19 19:36:43 peter
  1302. * More fixes for cross unit inlining, all tnodes are now implemented
  1303. * Moved pocall_internconst to po_internconst because it is not a
  1304. calling type at all and it conflicted when inlining of these small
  1305. functions was requested
  1306. Revision 1.52 2002/08/18 20:06:23 peter
  1307. * inlining is now also allowed in interface
  1308. * renamed write/load to ppuwrite/ppuload
  1309. * tnode storing in ppu
  1310. * nld,ncon,nbas are already updated for storing in ppu
  1311. Revision 1.51 2002/08/17 22:09:46 florian
  1312. * result type handling in tcgcal.pass_2 overhauled
  1313. * better tnode.dowrite
  1314. * some ppc stuff fixed
  1315. Revision 1.50 2002/08/17 09:23:37 florian
  1316. * first part of procinfo rewrite
  1317. Revision 1.49 2002/07/20 11:57:54 florian
  1318. * types.pas renamed to defbase.pas because D6 contains a types
  1319. unit so this would conflicts if D6 programms are compiled
  1320. + Willamette/SSE2 instructions to assembler added
  1321. Revision 1.48 2002/07/20 07:44:37 daniel
  1322. * Forgot to add a $ifdef extdebug
  1323. Revision 1.47 2002/07/19 12:55:27 daniel
  1324. * Further developed state tracking in whilerepeatn
  1325. Revision 1.46 2002/07/19 11:41:36 daniel
  1326. * State tracker work
  1327. * The whilen and repeatn are now completely unified into whilerepeatn. This
  1328. allows the state tracker to change while nodes automatically into
  1329. repeat nodes.
  1330. * Resulttypepass improvements to the notn. 'not not a' is optimized away and
  1331. 'not(a>b)' is optimized into 'a<=b'.
  1332. * Resulttypepass improvements to the whilerepeatn. 'while not a' is optimized
  1333. by removing the notn and later switchting the true and falselabels. The
  1334. same is done with 'repeat until not a'.
  1335. Revision 1.45 2002/07/15 18:03:15 florian
  1336. * readded removed changes
  1337. Revision 1.43 2002/07/11 14:41:28 florian
  1338. * start of the new generic parameter handling
  1339. Revision 1.44 2002/07/14 18:00:44 daniel
  1340. + Added the beginning of a state tracker. This will track the values of
  1341. variables through procedures and optimize things away.
  1342. Revision 1.42 2002/05/18 13:34:10 peter
  1343. * readded missing revisions
  1344. Revision 1.41 2002/05/16 19:46:38 carl
  1345. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  1346. + try to fix temp allocation (still in ifdef)
  1347. + generic constructor calls
  1348. + start of tassembler / tmodulebase class cleanup
  1349. Revision 1.39 2002/05/12 16:53:07 peter
  1350. * moved entry and exitcode to ncgutil and cgobj
  1351. * foreach gets extra argument for passing local data to the
  1352. iterator function
  1353. * -CR checks also class typecasts at runtime by changing them
  1354. into as
  1355. * fixed compiler to cycle with the -CR option
  1356. * fixed stabs with elf writer, finally the global variables can
  1357. be watched
  1358. * removed a lot of routines from cga unit and replaced them by
  1359. calls to cgobj
  1360. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  1361. u32bit then the other is typecasted also to u32bit without giving
  1362. a rangecheck warning/error.
  1363. * fixed pascal calling method with reversing also the high tree in
  1364. the parast, detected by tcalcst3 test
  1365. Revision 1.38 2002/04/25 20:16:39 peter
  1366. * moved more routines from cga/n386util
  1367. Revision 1.37 2002/04/23 19:16:34 peter
  1368. * add pinline unit that inserts compiler supported functions using
  1369. one or more statements
  1370. * moved finalize and setlength from ninl to pinline
  1371. }