nld.pas 56 KB

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