nld.pas 36 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083
  1. {
  2. $Id$
  3. Copyright (c) 2000 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 defines.inc}
  20. interface
  21. uses
  22. node,
  23. symconst,symbase,symtype,symsym,symdef;
  24. type
  25. tloadnode = class(tunarynode)
  26. symtableentry : tsym;
  27. symtable : tsymtable;
  28. procdeflist : tprocdef;
  29. constructor create(v : tsym;st : tsymtable);virtual;
  30. constructor create_procvar(v : tsym;d:tprocdef;st : tsymtable);virtual;
  31. procedure set_mp(p:tnode);
  32. function getcopy : tnode;override;
  33. function pass_1 : tnode;override;
  34. function det_resulttype:tnode;override;
  35. function docompare(p: tnode): boolean; override;
  36. end;
  37. tloadnodeclass = class of tloadnode;
  38. { different assignment types }
  39. tassigntype = (at_normal,at_plus,at_minus,at_star,at_slash);
  40. tassignmentnode = class(tbinarynode)
  41. assigntype : tassigntype;
  42. constructor create(l,r : tnode);virtual;
  43. function getcopy : tnode;override;
  44. function pass_1 : tnode;override;
  45. function det_resulttype:tnode;override;
  46. function docompare(p: tnode): boolean; override;
  47. end;
  48. tassignmentnodeclass = class of tassignmentnode;
  49. tfuncretnode = class(tnode)
  50. funcretsym : tfuncretsym;
  51. constructor create(v:tsym);virtual;
  52. function getcopy : tnode;override;
  53. function pass_1 : tnode;override;
  54. function det_resulttype:tnode;override;
  55. function docompare(p: tnode): boolean; override;
  56. end;
  57. tfuncretnodeclass = class of tfuncretnode;
  58. tarrayconstructorrangenode = class(tbinarynode)
  59. constructor create(l,r : tnode);virtual;
  60. function pass_1 : tnode;override;
  61. function det_resulttype:tnode;override;
  62. end;
  63. tarrayconstructorrangenodeclass = class of tarrayconstructorrangenode;
  64. tarrayconstructornode = class(tbinarynode)
  65. constructor create(l,r : tnode);virtual;
  66. function getcopy : tnode;override;
  67. function pass_1 : tnode;override;
  68. function det_resulttype:tnode;override;
  69. function docompare(p: tnode): boolean; override;
  70. procedure force_type(tt:ttype);
  71. end;
  72. tarrayconstructornodeclass = class of tarrayconstructornode;
  73. ttypenode = class(tnode)
  74. allowed : boolean;
  75. restype : ttype;
  76. constructor create(t : ttype);virtual;
  77. function pass_1 : tnode;override;
  78. function det_resulttype:tnode;override;
  79. function docompare(p: tnode): boolean; override;
  80. end;
  81. ttypenodeclass = class of ttypenode;
  82. trttinode = class(tnode)
  83. l1,l2 : longint;
  84. rttitype : trttitype;
  85. rttidef : tstoreddef;
  86. constructor create(def:tstoreddef;rt:trttitype);virtual;
  87. function getcopy : tnode;override;
  88. function pass_1 : tnode;override;
  89. procedure pass_2;override;
  90. function det_resulttype:tnode;override;
  91. function docompare(p: tnode): boolean; override;
  92. end;
  93. trttinodeclass = class of trttinode;
  94. var
  95. cloadnode : tloadnodeclass;
  96. cassignmentnode : tassignmentnodeclass;
  97. cfuncretnode : tfuncretnodeclass;
  98. carrayconstructorrangenode : tarrayconstructorrangenodeclass;
  99. carrayconstructornode : tarrayconstructornodeclass;
  100. ctypenode : ttypenodeclass;
  101. crttinode : trttinodeclass;
  102. implementation
  103. uses
  104. cutils,verbose,globtype,globals,systems,
  105. symtable,types,
  106. htypechk,pass_1,
  107. ncnv,nmem,ncal,cpubase,rgobj,cginfo,cgbase
  108. ;
  109. {*****************************************************************************
  110. TLOADNODE
  111. *****************************************************************************}
  112. constructor tloadnode.create(v : tsym;st : tsymtable);
  113. begin
  114. inherited create(loadn,nil);
  115. if not assigned(v) then
  116. internalerror(200108121);
  117. symtableentry:=v;
  118. symtable:=st;
  119. procdeflist:=nil;
  120. end;
  121. constructor tloadnode.create_procvar(v : tsym;d:tprocdef;st : tsymtable);
  122. begin
  123. inherited create(loadn,nil);
  124. if not assigned(v) then
  125. internalerror(200108121);
  126. symtableentry:=v;
  127. symtable:=st;
  128. procdeflist:=d;
  129. end;
  130. procedure tloadnode.set_mp(p:tnode);
  131. begin
  132. left:=p;
  133. end;
  134. function tloadnode.getcopy : tnode;
  135. var
  136. n : tloadnode;
  137. begin
  138. n:=tloadnode(inherited getcopy);
  139. n.symtable:=symtable;
  140. n.symtableentry:=symtableentry;
  141. result:=n;
  142. end;
  143. function tloadnode.det_resulttype:tnode;
  144. var
  145. p1 : tnode;
  146. p : pprocinfo;
  147. begin
  148. result:=nil;
  149. { optimize simple with loadings }
  150. if (symtable.symtabletype=withsymtable) and
  151. (twithsymtable(symtable).direct_with) and
  152. (symtableentry.typ=varsym) then
  153. begin
  154. p1:=tnode(twithsymtable(symtable).withrefnode).getcopy;
  155. p1:=csubscriptnode.create(tvarsym(symtableentry),p1);
  156. left:=nil;
  157. result:=p1;
  158. exit;
  159. end;
  160. { handle first absolute as it will replace the symtableentry }
  161. if symtableentry.typ=absolutesym then
  162. begin
  163. { force the resulttype to the type of the absolute }
  164. resulttype:=tabsolutesym(symtableentry).vartype;
  165. { replace the symtableentry when it points to a var, else
  166. we are finished }
  167. if tabsolutesym(symtableentry).abstyp=tovar then
  168. begin
  169. symtableentry:=tabsolutesym(symtableentry).ref;
  170. symtable:=symtableentry.owner;
  171. include(flags,nf_absolute);
  172. end
  173. else
  174. exit;
  175. end;
  176. case symtableentry.typ of
  177. funcretsym :
  178. begin
  179. { find the main funcret for the function }
  180. p:=procinfo;
  181. while assigned(p) do
  182. begin
  183. if assigned(p^.procdef.funcretsym) and
  184. ((tfuncretsym(symtableentry)=p^.procdef.resultfuncretsym) or
  185. (tfuncretsym(symtableentry)=p^.procdef.funcretsym)) then
  186. begin
  187. symtableentry:=p^.procdef.funcretsym;
  188. break;
  189. end;
  190. p:=p^.parent;
  191. end;
  192. { generate funcretnode }
  193. p1:=cfuncretnode.create(symtableentry);
  194. resulttypepass(p1);
  195. { if it's refered as absolute then we need to have the
  196. type of the absolute instead of the function return,
  197. the function return is then also assigned }
  198. if nf_absolute in flags then
  199. begin
  200. tfuncretsym(symtableentry).funcretstate:=vs_assigned;
  201. p1.resulttype:=resulttype;
  202. end;
  203. left:=nil;
  204. result:=p1;
  205. end;
  206. constsym:
  207. begin
  208. if tconstsym(symtableentry).consttyp=constresourcestring then
  209. resulttype:=cansistringtype
  210. else
  211. internalerror(22799);
  212. end;
  213. varsym :
  214. begin
  215. { if it's refered by absolute then it's used }
  216. if nf_absolute in flags then
  217. tvarsym(symtableentry).varstate:=vs_used
  218. else
  219. resulttype:=tvarsym(symtableentry).vartype;
  220. end;
  221. typedconstsym :
  222. if not(nf_absolute in flags) then
  223. resulttype:=ttypedconstsym(symtableentry).typedconsttype;
  224. procsym :
  225. begin
  226. if not assigned(procdeflist) then
  227. begin
  228. if assigned(tprocsym(symtableentry).defs^.next) then
  229. CGMessage(parser_e_no_overloaded_procvars);
  230. resulttype.setdef(tprocsym(symtableentry).defs^.def);
  231. end
  232. else
  233. resulttype.setdef(procdeflist);
  234. if (m_tp_procvar in aktmodeswitches) then
  235. begin
  236. if assigned(left) then
  237. begin
  238. if left.nodetype=typen then
  239. begin
  240. { we need to return only a voidpointer,
  241. so no need to keep the typen }
  242. left.free;
  243. left:=nil;
  244. end;
  245. end
  246. else
  247. begin
  248. { if the owner of the procsym is a object, }
  249. { left must be set, if left isn't set }
  250. { it can be only self }
  251. if (tprocsym(symtableentry).owner.symtabletype=objectsymtable) then
  252. left:=cselfnode.create(tobjectdef(symtableentry.owner.defowner));
  253. end;
  254. end;
  255. { process methodpointer }
  256. if assigned(left) then
  257. begin
  258. resulttypepass(left);
  259. { turn on the allowed flag, the secondpass
  260. will handle the typen itself }
  261. if left.nodetype=typen then
  262. ttypenode(left).allowed:=true;
  263. end;
  264. end;
  265. else
  266. internalerror(200104141);
  267. end;
  268. end;
  269. function tloadnode.pass_1 : tnode;
  270. begin
  271. result:=nil;
  272. location.loc:=LOC_REFERENCE;
  273. registers32:=0;
  274. registersfpu:=0;
  275. {$ifdef SUPPORT_MMX}
  276. registersmmx:=0;
  277. {$endif SUPPORT_MMX}
  278. case symtableentry.typ of
  279. absolutesym :
  280. ;
  281. funcretsym :
  282. internalerror(200104142);
  283. constsym:
  284. begin
  285. if tconstsym(symtableentry).consttyp=constresourcestring then
  286. begin
  287. { we use ansistrings so no fast exit here }
  288. if assigned(procinfo) then
  289. procinfo^.no_fast_exit:=true;
  290. location.loc:=LOC_CREFERENCE;
  291. end;
  292. end;
  293. varsym :
  294. begin
  295. if (symtable.symtabletype in [parasymtable,localsymtable]) and
  296. (lexlevel>symtable.symtablelevel) then
  297. begin
  298. { if the variable is in an other stackframe then we need
  299. a register to dereference }
  300. if (symtable.symtablelevel)>0 then
  301. begin
  302. registers32:=1;
  303. { further, the variable can't be put into a register }
  304. tvarsym(symtableentry).varoptions:=
  305. tvarsym(symtableentry).varoptions-[vo_fpuregable,vo_regable];
  306. end;
  307. end;
  308. if (tvarsym(symtableentry).varspez=vs_const) then
  309. location.loc:=LOC_CREFERENCE;
  310. { we need a register for call by reference parameters }
  311. if (tvarsym(symtableentry).varspez in [vs_var,vs_out]) or
  312. ((tvarsym(symtableentry).varspez=vs_const) and
  313. push_addr_param(tvarsym(symtableentry).vartype.def)) or
  314. { call by value open arrays are also indirect addressed }
  315. is_open_array(tvarsym(symtableentry).vartype.def) then
  316. registers32:=1;
  317. if symtable.symtabletype=withsymtable then
  318. inc(registers32);
  319. if ([vo_is_thread_var,vo_is_dll_var]*tvarsym(symtableentry).varoptions)<>[] then
  320. registers32:=1;
  321. { count variable references }
  322. { this will create problem with local var set by
  323. under_procedures
  324. if (assigned(tvarsym(symtableentry).owner) and assigned(aktprocsym)
  325. and ((tvarsym(symtableentry).owner = aktprocdef.localst)
  326. or (tvarsym(symtableentry).owner = aktprocdef.localst))) then }
  327. if rg.t_times<1 then
  328. inc(tvarsym(symtableentry).refs)
  329. else
  330. inc(tvarsym(symtableentry).refs,rg.t_times);
  331. end;
  332. typedconstsym :
  333. ;
  334. procsym :
  335. begin
  336. { method pointer ? }
  337. if assigned(left) then
  338. begin
  339. firstpass(left);
  340. registers32:=max(registers32,left.registers32);
  341. registersfpu:=max(registersfpu,left.registersfpu);
  342. {$ifdef SUPPORT_MMX}
  343. registersmmx:=max(registersmmx,left.registersmmx);
  344. {$endif SUPPORT_MMX}
  345. end;
  346. end;
  347. else
  348. internalerror(200104143);
  349. end;
  350. end;
  351. function tloadnode.docompare(p: tnode): boolean;
  352. begin
  353. docompare :=
  354. inherited docompare(p) and
  355. (symtableentry = tloadnode(p).symtableentry) and
  356. (symtable = tloadnode(p).symtable);
  357. end;
  358. {*****************************************************************************
  359. TASSIGNMENTNODE
  360. *****************************************************************************}
  361. constructor tassignmentnode.create(l,r : tnode);
  362. begin
  363. inherited create(assignn,l,r);
  364. assigntype:=at_normal;
  365. end;
  366. function tassignmentnode.getcopy : tnode;
  367. var
  368. n : tassignmentnode;
  369. begin
  370. n:=tassignmentnode(inherited getcopy);
  371. n.assigntype:=assigntype;
  372. getcopy:=n;
  373. end;
  374. function tassignmentnode.det_resulttype:tnode;
  375. var
  376. hp : tnode;
  377. begin
  378. result:=nil;
  379. resulttype:=voidtype;
  380. { must be made unique }
  381. if assigned(left) then
  382. begin
  383. set_unique(left);
  384. { set we the function result? }
  385. set_funcret_is_valid(left);
  386. end;
  387. resulttypepass(left);
  388. resulttypepass(right);
  389. set_varstate(left,false);
  390. set_varstate(right,true);
  391. if codegenerror then
  392. exit;
  393. { assignments to open arrays aren't allowed }
  394. if is_open_array(left.resulttype.def) then
  395. CGMessage(type_e_mismatch);
  396. { assigning nil to a dynamic array clears the array }
  397. if is_dynamic_array(left.resulttype.def) and
  398. (right.nodetype=niln) then
  399. begin
  400. hp:=ccallparanode.create(caddrnode.create
  401. (crttinode.create(tstoreddef(left.resulttype.def),initrtti)),
  402. ccallparanode.create(ctypeconvnode.create_explicit(left,voidpointertype),nil));
  403. result := ccallnode.createintern('fpc_dynarray_clear',hp);
  404. left:=nil;
  405. exit;
  406. end;
  407. { some string functions don't need conversion, so treat them separatly }
  408. if not (
  409. is_shortstring(left.resulttype.def) and
  410. (
  411. is_shortstring(right.resulttype.def) or
  412. is_ansistring(right.resulttype.def) or
  413. is_char(right.resulttype.def)
  414. )
  415. ) then
  416. inserttypeconv(right,left.resulttype);
  417. { test if node can be assigned, properties are allowed }
  418. valid_for_assignment(left);
  419. { check if local proc/func is assigned to procvar }
  420. if right.resulttype.def.deftype=procvardef then
  421. test_local_to_procvar(tprocvardef(right.resulttype.def),left.resulttype.def);
  422. end;
  423. function tassignmentnode.pass_1 : tnode;
  424. begin
  425. result:=nil;
  426. firstpass(left);
  427. firstpass(right);
  428. if codegenerror then
  429. exit;
  430. { some string functions don't need conversion, so treat them separatly }
  431. if is_shortstring(left.resulttype.def) and
  432. (
  433. is_shortstring(right.resulttype.def) or
  434. is_ansistring(right.resulttype.def) or
  435. is_char(right.resulttype.def)
  436. ) then
  437. begin
  438. { we call STRCOPY }
  439. procinfo^.flags:=procinfo^.flags or pi_do_call;
  440. { test for s:=s+anything ... }
  441. { the problem is for
  442. s:=s+s+s;
  443. this is broken here !! }
  444. {$ifdef newoptimizations2}
  445. { the above is fixed now, but still problem with s := s + f(); if }
  446. { f modifies s (bad programming, so only enable if uncertain }
  447. { optimizations are on) (JM) }
  448. if (cs_UncertainOpts in aktglobalswitches) then
  449. begin
  450. hp := right;
  451. while hp.treetype=addn do hp:=hp.left;
  452. if equal_trees(left,hp) and
  453. not multiple_uses(left,right) then
  454. begin
  455. concat_string:=true;
  456. hp:=right;
  457. while hp.treetype=addn do
  458. begin
  459. hp.use_strconcat:=true;
  460. hp:=hp.left;
  461. end;
  462. end;
  463. end;
  464. {$endif newoptimizations2}
  465. end;
  466. registers32:=left.registers32+right.registers32;
  467. registersfpu:=max(left.registersfpu,right.registersfpu);
  468. {$ifdef SUPPORT_MMX}
  469. registersmmx:=max(left.registersmmx,right.registersmmx);
  470. {$endif SUPPORT_MMX}
  471. end;
  472. function tassignmentnode.docompare(p: tnode): boolean;
  473. begin
  474. docompare :=
  475. inherited docompare(p) and
  476. (assigntype = tassignmentnode(p).assigntype);
  477. end;
  478. {*****************************************************************************
  479. TFUNCRETNODE
  480. *****************************************************************************}
  481. constructor tfuncretnode.create(v:tsym);
  482. begin
  483. inherited create(funcretn);
  484. funcretsym:=tfuncretsym(v);
  485. end;
  486. function tfuncretnode.getcopy : tnode;
  487. var
  488. n : tfuncretnode;
  489. begin
  490. n:=tfuncretnode(inherited getcopy);
  491. n.funcretsym:=funcretsym;
  492. getcopy:=n;
  493. end;
  494. function tfuncretnode.det_resulttype:tnode;
  495. begin
  496. result:=nil;
  497. resulttype:=funcretsym.returntype;
  498. end;
  499. function tfuncretnode.pass_1 : tnode;
  500. begin
  501. result:=nil;
  502. location.loc:=LOC_REFERENCE;
  503. if ret_in_param(resulttype.def) or
  504. (lexlevel<>funcretsym.owner.symtablelevel) then
  505. registers32:=1;
  506. end;
  507. function tfuncretnode.docompare(p: tnode): boolean;
  508. begin
  509. docompare :=
  510. inherited docompare(p) and
  511. (funcretsym = tfuncretnode(p).funcretsym);
  512. end;
  513. {*****************************************************************************
  514. TARRAYCONSTRUCTORRANGENODE
  515. *****************************************************************************}
  516. constructor tarrayconstructorrangenode.create(l,r : tnode);
  517. begin
  518. inherited create(arrayconstructorrangen,l,r);
  519. end;
  520. function tarrayconstructorrangenode.det_resulttype:tnode;
  521. begin
  522. result:=nil;
  523. resulttypepass(left);
  524. resulttypepass(right);
  525. set_varstate(left,true);
  526. set_varstate(right,true);
  527. if codegenerror then
  528. exit;
  529. resulttype:=left.resulttype;
  530. end;
  531. function tarrayconstructorrangenode.pass_1 : tnode;
  532. begin
  533. firstpass(left);
  534. firstpass(right);
  535. location.loc := LOC_CREFERENCE;
  536. calcregisters(self,0,0,0);
  537. result:=nil;
  538. end;
  539. {****************************************************************************
  540. TARRAYCONSTRUCTORNODE
  541. *****************************************************************************}
  542. constructor tarrayconstructornode.create(l,r : tnode);
  543. begin
  544. inherited create(arrayconstructorn,l,r);
  545. end;
  546. function tarrayconstructornode.getcopy : tnode;
  547. var
  548. n : tarrayconstructornode;
  549. begin
  550. n:=tarrayconstructornode(inherited getcopy);
  551. result:=n;
  552. end;
  553. function tarrayconstructornode.det_resulttype:tnode;
  554. var
  555. htype : ttype;
  556. hp : tarrayconstructornode;
  557. len : longint;
  558. varia : boolean;
  559. begin
  560. result:=nil;
  561. { are we allowing array constructor? Then convert it to a set }
  562. if not allow_array_constructor then
  563. begin
  564. hp:=tarrayconstructornode(getcopy);
  565. arrayconstructor_to_set(hp);
  566. result:=hp;
  567. exit;
  568. end;
  569. { only pass left tree, right tree contains next construct if any }
  570. htype.reset;
  571. len:=0;
  572. varia:=false;
  573. if assigned(left) then
  574. begin
  575. hp:=self;
  576. while assigned(hp) do
  577. begin
  578. resulttypepass(hp.left);
  579. set_varstate(hp.left,true);
  580. if (htype.def=nil) then
  581. htype:=hp.left.resulttype
  582. else
  583. begin
  584. if ((nf_novariaallowed in flags) or (not varia)) and
  585. (not is_equal(htype.def,hp.left.resulttype.def)) then
  586. begin
  587. varia:=true;
  588. end;
  589. end;
  590. inc(len);
  591. hp:=tarrayconstructornode(hp.right);
  592. end;
  593. end;
  594. if not assigned(htype.def) then
  595. htype:=voidtype;
  596. resulttype.setdef(tarraydef.create(0,len-1,s32bittype));
  597. tarraydef(resulttype.def).elementtype:=htype;
  598. tarraydef(resulttype.def).IsConstructor:=true;
  599. tarraydef(resulttype.def).IsVariant:=varia;
  600. end;
  601. procedure tarrayconstructornode.force_type(tt:ttype);
  602. var
  603. hp : tarrayconstructornode;
  604. begin
  605. tarraydef(resulttype.def).elementtype:=tt;
  606. tarraydef(resulttype.def).IsConstructor:=true;
  607. tarraydef(resulttype.def).IsVariant:=false;
  608. if assigned(left) then
  609. begin
  610. hp:=self;
  611. while assigned(hp) do
  612. begin
  613. inserttypeconv(hp.left,tt);
  614. hp:=tarrayconstructornode(hp.right);
  615. end;
  616. end;
  617. end;
  618. function tarrayconstructornode.pass_1 : tnode;
  619. var
  620. thp,
  621. chp,
  622. hp : tarrayconstructornode;
  623. dovariant : boolean;
  624. htype : ttype;
  625. orgflags : tnodeflagset;
  626. begin
  627. dovariant:=(nf_forcevaria in flags) or tarraydef(resulttype.def).isvariant;
  628. result:=nil;
  629. { only pass left tree, right tree contains next construct if any }
  630. if assigned(left) then
  631. begin
  632. hp:=self;
  633. while assigned(hp) do
  634. begin
  635. firstpass(hp.left);
  636. { Insert typeconvs for array of const }
  637. if dovariant then
  638. begin
  639. case hp.left.resulttype.def.deftype of
  640. enumdef :
  641. begin
  642. hp.left:=ctypeconvnode.create(hp.left,s32bittype);
  643. firstpass(hp.left);
  644. end;
  645. orddef :
  646. begin
  647. if is_integer(hp.left.resulttype.def) and
  648. not(is_64bitint(hp.left.resulttype.def)) then
  649. begin
  650. hp.left:=ctypeconvnode.create(hp.left,s32bittype);
  651. firstpass(hp.left);
  652. end;
  653. end;
  654. floatdef :
  655. begin
  656. hp.left:=ctypeconvnode.create(hp.left,pbestrealtype^);
  657. firstpass(hp.left);
  658. end;
  659. stringdef :
  660. begin
  661. if nf_cargs in flags then
  662. begin
  663. hp.left:=ctypeconvnode.create(hp.left,charpointertype);
  664. firstpass(hp.left);
  665. end;
  666. end;
  667. procvardef :
  668. begin
  669. hp.left:=ctypeconvnode.create(hp.left,voidpointertype);
  670. firstpass(hp.left);
  671. end;
  672. pointerdef,
  673. classrefdef,
  674. objectdef : ;
  675. else
  676. CGMessagePos1(hp.left.fileinfo,type_e_wrong_type_in_array_constructor,hp.left.resulttype.def.typename);
  677. end;
  678. end;
  679. hp:=tarrayconstructornode(hp.right);
  680. end;
  681. { swap the tree for cargs }
  682. if (nf_cargs in flags) and (not(nf_cargswap in flags)) then
  683. begin
  684. chp:=nil;
  685. { save resulttype }
  686. htype:=resulttype;
  687. { we need a copy here, because self is destroyed }
  688. { by firstpass later }
  689. hp:=tarrayconstructornode(getcopy);
  690. { we also need a copy of the nf_ forcevaria flag to restore }
  691. { later) (JM) }
  692. orgflags := flags * [nf_forcevaria];
  693. while assigned(hp) do
  694. begin
  695. thp:=tarrayconstructornode(hp.right);
  696. hp.right:=chp;
  697. chp:=hp;
  698. hp:=thp;
  699. end;
  700. chp.flags := chp.flags+orgflags;
  701. include(chp.flags,nf_cargswap);
  702. chp.location.loc:=LOC_CREFERENCE;
  703. calcregisters(chp,0,0,0);
  704. chp.resulttype:=htype;
  705. result:=chp;
  706. exit;
  707. end;
  708. end;
  709. { C Arguments are pushed on the stack and
  710. are not accesible after the push }
  711. if not(nf_cargs in flags) then
  712. location.loc:=LOC_CREFERENCE
  713. else
  714. location.loc:=LOC_INVALID;
  715. calcregisters(self,0,0,0);
  716. end;
  717. function tarrayconstructornode.docompare(p: tnode): boolean;
  718. begin
  719. docompare :=
  720. inherited docompare(p);
  721. end;
  722. {*****************************************************************************
  723. TTYPENODE
  724. *****************************************************************************}
  725. constructor ttypenode.create(t : ttype);
  726. begin
  727. inherited create(typen);
  728. restype:=t;
  729. allowed:=false;
  730. end;
  731. function ttypenode.det_resulttype:tnode;
  732. begin
  733. result:=nil;
  734. resulttype:=restype;
  735. { check if it's valid }
  736. if restype.def.deftype = errordef then
  737. CGMessage(cg_e_illegal_expression);
  738. end;
  739. function ttypenode.pass_1 : tnode;
  740. begin
  741. result:=nil;
  742. { a typenode can't generate code, so we give here
  743. an error. Else it'll be an abstract error in pass_2.
  744. Only when the allowed flag is set we don't generate
  745. an error }
  746. if not allowed then
  747. Message(parser_e_no_type_not_allowed_here);
  748. end;
  749. function ttypenode.docompare(p: tnode): boolean;
  750. begin
  751. docompare :=
  752. inherited docompare(p);
  753. end;
  754. {*****************************************************************************
  755. TRTTINODE
  756. *****************************************************************************}
  757. constructor trttinode.create(def:tstoreddef;rt:trttitype);
  758. begin
  759. inherited create(rttin);
  760. rttidef:=def;
  761. rttitype:=rt;
  762. end;
  763. function trttinode.getcopy : tnode;
  764. var
  765. n : trttinode;
  766. begin
  767. n:=trttinode(inherited getcopy);
  768. n.rttidef:=rttidef;
  769. n.rttitype:=rttitype;
  770. result:=n;
  771. end;
  772. function trttinode.det_resulttype:tnode;
  773. begin
  774. { rtti information will be returned as a void pointer }
  775. result:=nil;
  776. resulttype:=voidpointertype;
  777. end;
  778. function trttinode.pass_1 : tnode;
  779. begin
  780. result:=nil;
  781. location.loc:=LOC_CREFERENCE;
  782. end;
  783. function trttinode.docompare(p: tnode): boolean;
  784. begin
  785. docompare :=
  786. inherited docompare(p) and
  787. (rttidef = trttinode(p).rttidef) and
  788. (rttitype = trttinode(p).rttitype);
  789. end;
  790. procedure trttinode.pass_2;
  791. begin
  792. location_reset(location,LOC_CREFERENCE,OS_NO);
  793. location.reference.symbol:=rttidef.get_rtti_label(rttitype);
  794. end;
  795. begin
  796. cloadnode:=tloadnode;
  797. cassignmentnode:=tassignmentnode;
  798. cfuncretnode:=tfuncretnode;
  799. carrayconstructorrangenode:=tarrayconstructorrangenode;
  800. carrayconstructornode:=tarrayconstructornode;
  801. ctypenode:=ttypenode;
  802. crttinode:=trttinode;
  803. end.
  804. {
  805. $Log$
  806. Revision 1.37 2002-04-23 19:16:34 peter
  807. * add pinline unit that inserts compiler supported functions using
  808. one or more statements
  809. * moved finalize and setlength from ninl to pinline
  810. Revision 1.36 2002/04/22 16:30:06 peter
  811. * fixed @methodpointer
  812. Revision 1.35 2002/04/21 19:02:04 peter
  813. * removed newn and disposen nodes, the code is now directly
  814. inlined from pexpr
  815. * -an option that will write the secondpass nodes to the .s file, this
  816. requires EXTDEBUG define to actually write the info
  817. * fixed various internal errors and crashes due recent code changes
  818. Revision 1.34 2002/04/02 17:11:29 peter
  819. * tlocation,treference update
  820. * LOC_CONSTANT added for better constant handling
  821. * secondadd splitted in multiple routines
  822. * location_force_reg added for loading a location to a register
  823. of a specified size
  824. * secondassignment parses now first the right and then the left node
  825. (this is compatible with Kylix). This saves a lot of push/pop especially
  826. with string operations
  827. * adapted some routines to use the new cg methods
  828. Revision 1.33 2002/03/31 20:26:34 jonas
  829. + a_loadfpu_* and a_loadmm_* methods in tcg
  830. * register allocation is now handled by a class and is mostly processor
  831. independent (+rgobj.pas and i386/rgcpu.pas)
  832. * temp allocation is now handled by a class (+tgobj.pas, -i386\tgcpu.pas)
  833. * some small improvements and fixes to the optimizer
  834. * some register allocation fixes
  835. * some fpuvaroffset fixes in the unary minus node
  836. * push/popusedregisters is now called rg.save/restoreusedregisters and
  837. (for i386) uses temps instead of push/pop's when using -Op3 (that code is
  838. also better optimizable)
  839. * fixed and optimized register saving/restoring for new/dispose nodes
  840. * LOC_FPU locations now also require their "register" field to be set to
  841. R_ST, not R_ST0 (the latter is used for LOC_CFPUREGISTER locations only)
  842. - list field removed of the tnode class because it's not used currently
  843. and can cause hard-to-find bugs
  844. Revision 1.32 2002/01/19 11:52:32 peter
  845. * dynarr:=nil support added
  846. Revision 1.31 2001/12/28 15:02:00 jonas
  847. * fixed web bug 1684 (it already didn't crash anymore, but it also didn't
  848. generate an error) ("merged")
  849. Revision 1.30 2001/11/07 13:52:52 jonas
  850. * only save/restore nf_forcevaria flag when reversing order of
  851. arrayconstructor elements, since the other flags are element specific
  852. Revision 1.29 2001/11/02 22:58:02 peter
  853. * procsym definition rewrite
  854. Revision 1.28 2001/10/31 17:34:20 jonas
  855. * fixed web bug 1651
  856. Revision 1.27 2001/10/28 17:22:25 peter
  857. * allow assignment of overloaded procedures to procvars when we know
  858. which procedure to take
  859. Revision 1.26 2001/10/12 13:51:51 jonas
  860. * fixed internalerror(10) due to previous fpu overflow fixes ("merged")
  861. * fixed bug in n386add (introduced after compilerproc changes for string
  862. operations) where calcregisters wasn't called for shortstring addnodes
  863. * NOTE: from now on, the location of a binary node must now always be set
  864. before you call calcregisters() for it
  865. Revision 1.25 2001/09/02 21:12:07 peter
  866. * move class of definitions into type section for delphi
  867. Revision 1.24 2001/08/30 15:48:34 jonas
  868. * fix from Peter for getting correct symtableentry for funcret loads
  869. Revision 1.23 2001/08/26 13:36:41 florian
  870. * some cg reorganisation
  871. * some PPC updates
  872. Revision 1.22 2001/08/12 22:11:52 peter
  873. * errordef.typesym is not updated anymore
  874. Revision 1.21 2001/08/06 21:40:47 peter
  875. * funcret moved from tprocinfo to tprocdef
  876. Revision 1.20 2001/07/30 20:52:25 peter
  877. * fixed array constructor passing with type conversions
  878. Revision 1.19 2001/06/04 18:07:47 peter
  879. * remove unused typenode for procvar load. Don't know what happened why
  880. this code was not there already with revision 1.17.
  881. Revision 1.18 2001/06/04 11:48:01 peter
  882. * better const to var checking
  883. Revision 1.17 2001/05/19 21:19:57 peter
  884. * remove unused typenode for procvars to prevent error
  885. * typenode.allowed flag to allow a typenode
  886. Revision 1.16 2001/05/09 19:57:51 peter
  887. * typenode doesn't generate code, give error in pass_1 instead of
  888. getting an abstract methode runtime error
  889. Revision 1.15 2001/04/14 14:06:31 peter
  890. * move more code from loadnode.pass_1 to det_resulttype
  891. Revision 1.14 2001/04/13 01:22:10 peter
  892. * symtable change to classes
  893. * range check generation and errors fixed, make cycle DEBUG=1 works
  894. * memory leaks fixed
  895. Revision 1.13 2001/04/05 21:03:08 peter
  896. * array constructor fix
  897. Revision 1.12 2001/04/04 22:42:40 peter
  898. * move constant folding into det_resulttype
  899. Revision 1.11 2001/04/02 21:20:31 peter
  900. * resulttype rewrite
  901. Revision 1.10 2000/12/31 11:14:10 jonas
  902. + implemented/fixed docompare() mathods for all nodes (not tested)
  903. + nopt.pas, nadd.pas, i386/n386opt.pas: optimized nodes for adding strings
  904. and constant strings/chars together
  905. * n386add.pas: don't copy temp strings (of size 256) to another temp string
  906. when adding
  907. Revision 1.9 2000/11/29 00:30:33 florian
  908. * unused units removed from uses clause
  909. * some changes for widestrings
  910. Revision 1.8 2000/11/04 14:25:20 florian
  911. + merged Attila's changes for interfaces, not tested yet
  912. Revision 1.7 2000/10/31 22:02:49 peter
  913. * symtable splitted, no real code changes
  914. Revision 1.6 2000/10/14 10:14:50 peter
  915. * moehrendorf oct 2000 rewrite
  916. Revision 1.5 2000/10/01 19:48:24 peter
  917. * lot of compile updates for cg11
  918. Revision 1.4 2000/09/28 19:49:52 florian
  919. *** empty log message ***
  920. Revision 1.3 2000/09/27 18:14:31 florian
  921. * fixed a lot of syntax errors in the n*.pas stuff
  922. Revision 1.2 2000/09/25 15:37:14 florian
  923. * more fixes
  924. Revision 1.1 2000/09/25 14:55:05 florian
  925. * initial revision
  926. }