nld.pas 55 KB

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