nld.pas 55 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619
  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. hp.left:=ctypeconvnode.create(hp.left,pbestrealtype^);
  905. procvardef :
  906. hp.left:=ctypeconvnode.create(hp.left,voidpointertype);
  907. stringdef,
  908. variantdef,
  909. pointerdef,
  910. classrefdef,
  911. objectdef : ;
  912. else
  913. CGMessagePos1(hp.left.fileinfo,type_e_wrong_type_in_array_constructor,hp.left.resulttype.def.typename);
  914. end;
  915. end;
  916. resulttypepass(hp.left);
  917. hp:=tarrayconstructornode(hp.right);
  918. end;
  919. end;
  920. end;
  921. function tarrayconstructornode.pass_1 : tnode;
  922. var
  923. hp : tarrayconstructornode;
  924. begin
  925. result:=nil;
  926. { Insert required type convs, this must be
  927. done in pass 1, because the call must be
  928. resulttypepassed already }
  929. if assigned(left) then
  930. begin
  931. insert_typeconvs;
  932. { call firstpass for all nodes }
  933. hp:=self;
  934. while assigned(hp) do
  935. begin
  936. firstpass(hp.left);
  937. hp:=tarrayconstructornode(hp.right);
  938. end;
  939. end;
  940. expectloc:=LOC_CREFERENCE;
  941. calcregisters(self,0,0,0);
  942. end;
  943. function tarrayconstructornode.docompare(p: tnode): boolean;
  944. begin
  945. docompare :=
  946. inherited docompare(p);
  947. end;
  948. {*****************************************************************************
  949. TTYPENODE
  950. *****************************************************************************}
  951. constructor ttypenode.create(t : ttype);
  952. begin
  953. inherited create(typen);
  954. restype:=t;
  955. allowed:=false;
  956. end;
  957. constructor ttypenode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  958. begin
  959. inherited ppuload(t,ppufile);
  960. ppufile.gettype(restype);
  961. allowed:=boolean(ppufile.getbyte);
  962. end;
  963. procedure ttypenode.ppuwrite(ppufile:tcompilerppufile);
  964. begin
  965. inherited ppuwrite(ppufile);
  966. ppufile.puttype(restype);
  967. ppufile.putbyte(byte(allowed));
  968. end;
  969. procedure ttypenode.buildderefimpl;
  970. begin
  971. inherited buildderefimpl;
  972. restype.buildderef;
  973. end;
  974. procedure ttypenode.derefimpl;
  975. begin
  976. inherited derefimpl;
  977. restype.resolve;
  978. end;
  979. function ttypenode.det_resulttype:tnode;
  980. begin
  981. result:=nil;
  982. resulttype:=restype;
  983. { check if it's valid }
  984. if restype.def.deftype = errordef then
  985. CGMessage(cg_e_illegal_expression);
  986. end;
  987. function ttypenode.pass_1 : tnode;
  988. begin
  989. result:=nil;
  990. expectloc:=LOC_VOID;
  991. { a typenode can't generate code, so we give here
  992. an error. Else it'll be an abstract error in pass_2.
  993. Only when the allowed flag is set we don't generate
  994. an error }
  995. if not allowed then
  996. Message(parser_e_no_type_not_allowed_here);
  997. end;
  998. function ttypenode.docompare(p: tnode): boolean;
  999. begin
  1000. docompare :=
  1001. inherited docompare(p);
  1002. end;
  1003. {*****************************************************************************
  1004. TRTTINODE
  1005. *****************************************************************************}
  1006. constructor trttinode.create(def:tstoreddef;rt:trttitype);
  1007. begin
  1008. inherited create(rttin);
  1009. rttidef:=def;
  1010. rttitype:=rt;
  1011. end;
  1012. constructor trttinode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  1013. begin
  1014. inherited ppuload(t,ppufile);
  1015. ppufile.getderef(rttidefderef);
  1016. rttitype:=trttitype(ppufile.getbyte);
  1017. end;
  1018. procedure trttinode.ppuwrite(ppufile:tcompilerppufile);
  1019. begin
  1020. inherited ppuwrite(ppufile);
  1021. ppufile.putderef(rttidefderef);
  1022. ppufile.putbyte(byte(rttitype));
  1023. end;
  1024. procedure trttinode.buildderefimpl;
  1025. begin
  1026. inherited buildderefimpl;
  1027. rttidefderef.build(rttidef);
  1028. end;
  1029. procedure trttinode.derefimpl;
  1030. begin
  1031. inherited derefimpl;
  1032. rttidef:=tstoreddef(rttidefderef.resolve);
  1033. end;
  1034. function trttinode.getcopy : tnode;
  1035. var
  1036. n : trttinode;
  1037. begin
  1038. n:=trttinode(inherited getcopy);
  1039. n.rttidef:=rttidef;
  1040. n.rttitype:=rttitype;
  1041. result:=n;
  1042. end;
  1043. function trttinode.det_resulttype:tnode;
  1044. begin
  1045. { rtti information will be returned as a void pointer }
  1046. result:=nil;
  1047. resulttype:=voidpointertype;
  1048. end;
  1049. function trttinode.pass_1 : tnode;
  1050. begin
  1051. result:=nil;
  1052. expectloc:=LOC_CREFERENCE;
  1053. end;
  1054. function trttinode.docompare(p: tnode): boolean;
  1055. begin
  1056. docompare :=
  1057. inherited docompare(p) and
  1058. (rttidef = trttinode(p).rttidef) and
  1059. (rttitype = trttinode(p).rttitype);
  1060. end;
  1061. procedure trttinode.pass_2;
  1062. begin
  1063. location_reset(location,LOC_CREFERENCE,OS_NO);
  1064. location.reference.symbol:=rttidef.get_rtti_label(rttitype);
  1065. end;
  1066. begin
  1067. cloadnode:=tloadnode;
  1068. cassignmentnode:=tassignmentnode;
  1069. carrayconstructorrangenode:=tarrayconstructorrangenode;
  1070. carrayconstructornode:=tarrayconstructornode;
  1071. ctypenode:=ttypenode;
  1072. crttinode:=trttinode;
  1073. end.
  1074. {
  1075. $Log$
  1076. Revision 1.118 2003-11-26 14:25:26 michael
  1077. + Applied patch from peter to support ansistrings in array constructors
  1078. Revision 1.117 2003/11/23 17:39:33 peter
  1079. * removed obsolete nf_cargs flag
  1080. Revision 1.116 2003/10/28 15:36:01 peter
  1081. * absolute to object field supported, fixes tb0458
  1082. Revision 1.115 2003/10/23 14:44:07 peter
  1083. * splitted buildderef and buildderefimpl to fix interface crc
  1084. calculation
  1085. Revision 1.114 2003/10/22 20:40:00 peter
  1086. * write derefdata in a separate ppu entry
  1087. Revision 1.113 2003/10/17 14:38:32 peter
  1088. * 64k registers supported
  1089. * fixed some memory leaks
  1090. Revision 1.112 2003/10/10 17:48:13 peter
  1091. * old trgobj moved to x86/rgcpu and renamed to trgx86fpu
  1092. * tregisteralloctor renamed to trgobj
  1093. * removed rgobj from a lot of units
  1094. * moved location_* and reference_* to cgobj
  1095. * first things for mmx register allocation
  1096. Revision 1.111 2003/10/09 21:31:37 daniel
  1097. * Register allocator splitted, ans abstract now
  1098. Revision 1.110 2003/10/08 19:19:45 peter
  1099. * set_varstate cleanup
  1100. Revision 1.109 2003/10/05 21:21:52 peter
  1101. * c style array of const generates callparanodes
  1102. * varargs paraloc fixes
  1103. Revision 1.108 2003/10/01 20:34:48 peter
  1104. * procinfo unit contains tprocinfo
  1105. * cginfo renamed to cgbase
  1106. * moved cgmessage to verbose
  1107. * fixed ppc and sparc compiles
  1108. Revision 1.107 2003/09/28 17:55:03 peter
  1109. * parent framepointer changed to hidden parameter
  1110. * tloadparentfpnode added
  1111. Revision 1.106 2003/09/23 17:56:05 peter
  1112. * locals and paras are allocated in the code generation
  1113. * tvarsym.localloc contains the location of para/local when
  1114. generating code for the current procedure
  1115. Revision 1.105 2003/09/16 16:17:01 peter
  1116. * varspez in calls to push_addr_param
  1117. Revision 1.104 2003/09/07 22:09:35 peter
  1118. * preparations for different default calling conventions
  1119. * various RA fixes
  1120. Revision 1.103 2003/07/08 15:20:56 peter
  1121. * don't allow add/assignments for formaldef
  1122. * formaldef size changed to 0
  1123. Revision 1.102 2003/06/13 21:19:30 peter
  1124. * current_procdef removed, use current_procinfo.procdef instead
  1125. Revision 1.101 2003/06/08 20:01:53 jonas
  1126. * optimized assignments with on the right side a function that returns
  1127. an ansi- or widestring
  1128. Revision 1.100 2003/06/08 18:27:15 jonas
  1129. + ability to change the location of a ttempref node with changelocation()
  1130. method. Useful to use instead of copying the contents from one temp to
  1131. another
  1132. + some shortstring optimizations in tassignmentnode that avoid some
  1133. copying (required some shortstring optimizations to be moved from
  1134. resulttype to firstpass, because they work on callnodes and string
  1135. addnodes are only changed to callnodes in the firstpass)
  1136. * allow setting/changing the funcretnode of callnodes after the
  1137. resulttypepass has been done, funcretnode is now a property
  1138. (all of the above should have a quite big effect on callparatemp)
  1139. Revision 1.99 2003/06/07 20:26:32 peter
  1140. * re-resolving added instead of reloading from ppu
  1141. * tderef object added to store deref info for resolving
  1142. Revision 1.98 2003/06/07 18:57:04 jonas
  1143. + added freeintparaloc
  1144. * ppc get/freeintparaloc now check whether the parameter regs are
  1145. properly allocated/deallocated (and get an extra list para)
  1146. * ppc a_call_* now internalerrors if pi_do_call is not yet set
  1147. * fixed lot of missing pi_do_call's
  1148. Revision 1.97 2003/06/07 14:39:18 jonas
  1149. * set pi_do_call for accesses to threadvars
  1150. Revision 1.96 2003/05/26 19:38:28 peter
  1151. * generic fpc_shorstr_concat
  1152. + fpc_shortstr_append_shortstr optimization
  1153. Revision 1.95 2003/05/23 17:05:13 peter
  1154. * loadn procsym need to return procdef
  1155. Revision 1.94 2003/05/23 14:27:35 peter
  1156. * remove some unit dependencies
  1157. * current_procinfo changes to store more info
  1158. Revision 1.93 2003/05/11 21:37:03 peter
  1159. * moved implicit exception frame from ncgutil to psub
  1160. * constructor/destructor helpers moved from cobj/ncgutil to psub
  1161. Revision 1.92 2003/05/11 14:45:12 peter
  1162. * tloadnode does not support objectsymtable,withsymtable anymore
  1163. * withnode cleanup
  1164. * direct with rewritten to use temprefnode
  1165. Revision 1.91 2003/05/09 17:47:02 peter
  1166. * self moved to hidden parameter
  1167. * removed hdisposen,hnewn,selfn
  1168. Revision 1.90 2003/04/27 11:21:33 peter
  1169. * aktprocdef renamed to current_procinfo.procdef
  1170. * procinfo renamed to current_procinfo
  1171. * procinfo will now be stored in current_module so it can be
  1172. cleaned up properly
  1173. * gen_main_procsym changed to create_main_proc and release_main_proc
  1174. to also generate a tprocinfo structure
  1175. * fixed unit implicit initfinal
  1176. Revision 1.89 2003/04/27 07:29:50 peter
  1177. * current_procinfo.procdef cleanup, current_procdef is now always nil when parsing
  1178. a new procdef declaration
  1179. * aktprocsym removed
  1180. * lexlevel removed, use symtable.symtablelevel instead
  1181. * implicit init/final code uses the normal genentry/genexit
  1182. * funcret state checking updated for new funcret handling
  1183. Revision 1.88 2003/04/26 00:28:42 peter
  1184. * removed load_funcret
  1185. Revision 1.87 2003/04/25 20:59:33 peter
  1186. * removed funcretn,funcretsym, function result is now in varsym
  1187. and aliases for result and function name are added using absolutesym
  1188. * vs_hidden parameter for funcret passed in parameter
  1189. * vs_hidden fixes
  1190. * writenode changed to printnode and released from extdebug
  1191. * -vp option added to generate a tree.log with the nodetree
  1192. * nicer printnode for statements, callnode
  1193. Revision 1.86 2003/04/23 20:16:04 peter
  1194. + added currency support based on int64
  1195. + is_64bit for use in cg units instead of is_64bitint
  1196. * removed cgmessage from n386add, replace with internalerrors
  1197. Revision 1.85 2003/04/23 10:10:54 peter
  1198. * procvar is not compared in addrn
  1199. Revision 1.84 2003/04/22 23:50:23 peter
  1200. * firstpass uses expectloc
  1201. * checks if there are differences between the expectloc and
  1202. location.loc from secondpass in EXTDEBUG
  1203. Revision 1.83 2003/04/11 15:01:23 peter
  1204. * fix bug 2438
  1205. Revision 1.82 2003/03/28 19:16:56 peter
  1206. * generic constructor working for i386
  1207. * remove fixed self register
  1208. * esi added as address register for i386
  1209. Revision 1.81 2003/03/11 21:46:24 jonas
  1210. * lots of new regallocator fixes, both in generic and ppc-specific code
  1211. (ppc compiler still can't compile the linux system unit though)
  1212. Revision 1.80 2003/01/07 16:52:58 jonas
  1213. * fixed ansistring+char and ansistring+shortstring optimizations (those
  1214. cases were always handled as ansistring+ansistring due to
  1215. typeconversions inserted by the add-node)
  1216. Revision 1.79 2003/01/05 22:44:14 peter
  1217. * remove a lot of code to support typen in loadn-procsym
  1218. Revision 1.78 2003/01/03 12:15:56 daniel
  1219. * Removed ifdefs around notifications
  1220. ifdefs around for loop optimizations remain
  1221. Revision 1.77 2002/12/31 09:55:58 daniel
  1222. + Notification implementation complete
  1223. + Add for loop code optimization using notifications
  1224. results in 1.5-1.9% speed improvement in nestloop benchmark
  1225. Optimization incomplete, compiler does not cycle yet with
  1226. notifications enabled.
  1227. Revision 1.76 2002/12/30 22:44:53 daniel
  1228. * Some work on notifications
  1229. Revision 1.75 2002/12/27 15:27:25 peter
  1230. * remove property indicator when calling internal helpers
  1231. Revision 1.74 2002/12/24 16:53:19 peter
  1232. * fix for tb0438
  1233. Revision 1.73 2002/12/20 18:14:53 peter
  1234. * fix result of high_tree when high was not available
  1235. Revision 1.72 2002/12/17 22:19:33 peter
  1236. * fixed pushing of records>8 bytes with stdcall
  1237. * simplified hightree loading
  1238. Revision 1.71 2002/12/07 14:27:07 carl
  1239. * 3% memory optimization
  1240. * changed some types
  1241. + added type checking with different size for call node and for
  1242. parameters
  1243. Revision 1.70 2002/12/02 19:38:06 carl
  1244. * fix some errors
  1245. Revision 1.69 2002/11/29 20:02:44 carl
  1246. * warning / hint for possible loss of data in assignment
  1247. Revision 1.68 2002/11/27 20:04:39 peter
  1248. * cdecl array of const fixes
  1249. Revision 1.67 2002/11/27 15:33:47 peter
  1250. * the never ending story of tp procvar hacks
  1251. Revision 1.66 2002/11/25 17:43:20 peter
  1252. * splitted defbase in defutil,symutil,defcmp
  1253. * merged isconvertable and is_equal into compare_defs(_ext)
  1254. * made operator search faster by walking the list only once
  1255. Revision 1.65 2002/11/18 17:31:57 peter
  1256. * pass proccalloption to ret_in_xxx and push_xxx functions
  1257. Revision 1.64 2002/11/15 01:58:52 peter
  1258. * merged changes from 1.0.7 up to 04-11
  1259. - -V option for generating bug report tracing
  1260. - more tracing for option parsing
  1261. - errors for cdecl and high()
  1262. - win32 import stabs
  1263. - win32 records<=8 are returned in eax:edx (turned off by default)
  1264. - heaptrc update
  1265. - more info for temp management in .s file with EXTDEBUG
  1266. Revision 1.63 2002/10/17 12:44:09 florian
  1267. + s:=s+<string type> where s is an ansistring is done via calls to append_ansistring_*
  1268. Revision 1.62 2002/10/05 12:43:25 carl
  1269. * fixes for Delphi 6 compilation
  1270. (warning : Some features do not work under Delphi)
  1271. Revision 1.61 2002/10/03 21:26:08 carl
  1272. + compile-time range checking for strings
  1273. Revision 1.60 2002/09/27 21:13:28 carl
  1274. * low-highval always checked if limit ober 2GB is reached (to avoid overflow)
  1275. Revision 1.59 2002/09/26 15:02:05 florian
  1276. + support of passing variants to "array of const"
  1277. Revision 1.58 2002/09/07 15:25:03 peter
  1278. * old logs removed and tabs fixed
  1279. Revision 1.57 2002/09/03 16:26:26 daniel
  1280. * Make Tprocdef.defs protected
  1281. Revision 1.56 2002/09/01 13:28:37 daniel
  1282. - write_access fields removed in favor of a flag
  1283. Revision 1.55 2002/09/01 08:01:16 daniel
  1284. * Removed sets from Tcallnode.det_resulttype
  1285. + Added read/write notifications of variables. These will be usefull
  1286. for providing information for several optimizations. For example
  1287. the value of the loop variable of a for loop does matter is the
  1288. variable is read after the for loop, but if it's no longer used
  1289. or written, it doesn't matter and this can be used to optimize
  1290. the loop code generation.
  1291. Revision 1.54 2002/08/25 19:25:19 peter
  1292. * sym.insert_in_data removed
  1293. * symtable.insertvardata/insertconstdata added
  1294. * removed insert_in_data call from symtable.insert, it needs to be
  1295. called separatly. This allows to deref the address calculation
  1296. * procedures now calculate the parast addresses after the procedure
  1297. directives are parsed. This fixes the cdecl parast problem
  1298. * push_addr_param has an extra argument that specifies if cdecl is used
  1299. or not
  1300. Revision 1.53 2002/08/19 19:36:43 peter
  1301. * More fixes for cross unit inlining, all tnodes are now implemented
  1302. * Moved pocall_internconst to po_internconst because it is not a
  1303. calling type at all and it conflicted when inlining of these small
  1304. functions was requested
  1305. Revision 1.52 2002/08/18 20:06:23 peter
  1306. * inlining is now also allowed in interface
  1307. * renamed write/load to ppuwrite/ppuload
  1308. * tnode storing in ppu
  1309. * nld,ncon,nbas are already updated for storing in ppu
  1310. Revision 1.51 2002/08/17 22:09:46 florian
  1311. * result type handling in tcgcal.pass_2 overhauled
  1312. * better tnode.dowrite
  1313. * some ppc stuff fixed
  1314. Revision 1.50 2002/08/17 09:23:37 florian
  1315. * first part of procinfo rewrite
  1316. Revision 1.49 2002/07/20 11:57:54 florian
  1317. * types.pas renamed to defbase.pas because D6 contains a types
  1318. unit so this would conflicts if D6 programms are compiled
  1319. + Willamette/SSE2 instructions to assembler added
  1320. Revision 1.48 2002/07/20 07:44:37 daniel
  1321. * Forgot to add a $ifdef extdebug
  1322. Revision 1.47 2002/07/19 12:55:27 daniel
  1323. * Further developed state tracking in whilerepeatn
  1324. Revision 1.46 2002/07/19 11:41:36 daniel
  1325. * State tracker work
  1326. * The whilen and repeatn are now completely unified into whilerepeatn. This
  1327. allows the state tracker to change while nodes automatically into
  1328. repeat nodes.
  1329. * Resulttypepass improvements to the notn. 'not not a' is optimized away and
  1330. 'not(a>b)' is optimized into 'a<=b'.
  1331. * Resulttypepass improvements to the whilerepeatn. 'while not a' is optimized
  1332. by removing the notn and later switchting the true and falselabels. The
  1333. same is done with 'repeat until not a'.
  1334. Revision 1.45 2002/07/15 18:03:15 florian
  1335. * readded removed changes
  1336. Revision 1.43 2002/07/11 14:41:28 florian
  1337. * start of the new generic parameter handling
  1338. Revision 1.44 2002/07/14 18:00:44 daniel
  1339. + Added the beginning of a state tracker. This will track the values of
  1340. variables through procedures and optimize things away.
  1341. Revision 1.42 2002/05/18 13:34:10 peter
  1342. * readded missing revisions
  1343. Revision 1.41 2002/05/16 19:46:38 carl
  1344. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  1345. + try to fix temp allocation (still in ifdef)
  1346. + generic constructor calls
  1347. + start of tassembler / tmodulebase class cleanup
  1348. Revision 1.39 2002/05/12 16:53:07 peter
  1349. * moved entry and exitcode to ncgutil and cgobj
  1350. * foreach gets extra argument for passing local data to the
  1351. iterator function
  1352. * -CR checks also class typecasts at runtime by changing them
  1353. into as
  1354. * fixed compiler to cycle with the -CR option
  1355. * fixed stabs with elf writer, finally the global variables can
  1356. be watched
  1357. * removed a lot of routines from cga unit and replaced them by
  1358. calls to cgobj
  1359. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  1360. u32bit then the other is typecasted also to u32bit without giving
  1361. a rangecheck warning/error.
  1362. * fixed pascal calling method with reversing also the high tree in
  1363. the parast, detected by tcalcst3 test
  1364. Revision 1.38 2002/04/25 20:16:39 peter
  1365. * moved more routines from cga/n386util
  1366. Revision 1.37 2002/04/23 19:16:34 peter
  1367. * add pinline unit that inserts compiler supported functions using
  1368. one or more statements
  1369. * moved finalize and setlength from ninl to pinline
  1370. }