nld.pas 56 KB

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