nld.pas 33 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027
  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,tgcpu,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 the owner of the procsym is a object, }
  235. { left must be set, if left isn't set }
  236. { it can be only self }
  237. { this code is only used in TP procvar mode }
  238. if (m_tp_procvar in aktmodeswitches) and
  239. not(assigned(left)) and
  240. (tprocsym(symtableentry).owner.symtabletype=objectsymtable) then
  241. begin
  242. left:=cselfnode.create(tobjectdef(symtableentry.owner.defowner));
  243. end;
  244. { process methodpointer }
  245. if assigned(left) then
  246. begin
  247. { if only typenode then remove }
  248. if left.nodetype=typen then
  249. begin
  250. left.free;
  251. left:=nil;
  252. end
  253. else
  254. resulttypepass(left);
  255. end;
  256. end;
  257. else
  258. internalerror(200104141);
  259. end;
  260. end;
  261. function tloadnode.pass_1 : tnode;
  262. begin
  263. result:=nil;
  264. location.loc:=LOC_REFERENCE;
  265. registers32:=0;
  266. registersfpu:=0;
  267. {$ifdef SUPPORT_MMX}
  268. registersmmx:=0;
  269. {$endif SUPPORT_MMX}
  270. case symtableentry.typ of
  271. absolutesym :
  272. ;
  273. funcretsym :
  274. internalerror(200104142);
  275. constsym:
  276. begin
  277. if tconstsym(symtableentry).consttyp=constresourcestring then
  278. begin
  279. { we use ansistrings so no fast exit here }
  280. if assigned(procinfo) then
  281. procinfo^.no_fast_exit:=true;
  282. location.loc:=LOC_MEM;
  283. end;
  284. end;
  285. varsym :
  286. begin
  287. if (symtable.symtabletype in [parasymtable,localsymtable]) and
  288. (lexlevel>symtable.symtablelevel) then
  289. begin
  290. { if the variable is in an other stackframe then we need
  291. a register to dereference }
  292. if (symtable.symtablelevel)>0 then
  293. begin
  294. registers32:=1;
  295. { further, the variable can't be put into a register }
  296. tvarsym(symtableentry).varoptions:=
  297. tvarsym(symtableentry).varoptions-[vo_fpuregable,vo_regable];
  298. end;
  299. end;
  300. if (tvarsym(symtableentry).varspez=vs_const) then
  301. location.loc:=LOC_MEM;
  302. { we need a register for call by reference parameters }
  303. if (tvarsym(symtableentry).varspez in [vs_var,vs_out]) or
  304. ((tvarsym(symtableentry).varspez=vs_const) and
  305. push_addr_param(tvarsym(symtableentry).vartype.def)) or
  306. { call by value open arrays are also indirect addressed }
  307. is_open_array(tvarsym(symtableentry).vartype.def) then
  308. registers32:=1;
  309. if symtable.symtabletype=withsymtable then
  310. inc(registers32);
  311. if ([vo_is_thread_var,vo_is_dll_var]*tvarsym(symtableentry).varoptions)<>[] then
  312. registers32:=1;
  313. { count variable references }
  314. { this will create problem with local var set by
  315. under_procedures
  316. if (assigned(tvarsym(symtableentry).owner) and assigned(aktprocsym)
  317. and ((tvarsym(symtableentry).owner = aktprocdef.localst)
  318. or (tvarsym(symtableentry).owner = aktprocdef.localst))) then }
  319. if t_times<1 then
  320. inc(tvarsym(symtableentry).refs)
  321. else
  322. inc(tvarsym(symtableentry).refs,t_times);
  323. end;
  324. typedconstsym :
  325. ;
  326. procsym :
  327. begin
  328. { method pointer ? }
  329. if assigned(left) then
  330. begin
  331. firstpass(left);
  332. registers32:=max(registers32,left.registers32);
  333. registersfpu:=max(registersfpu,left.registersfpu);
  334. {$ifdef SUPPORT_MMX}
  335. registersmmx:=max(registersmmx,left.registersmmx);
  336. {$endif SUPPORT_MMX}
  337. end;
  338. end;
  339. else
  340. internalerror(200104143);
  341. end;
  342. end;
  343. function tloadnode.docompare(p: tnode): boolean;
  344. begin
  345. docompare :=
  346. inherited docompare(p) and
  347. (symtableentry = tloadnode(p).symtableentry) and
  348. (symtable = tloadnode(p).symtable);
  349. end;
  350. {*****************************************************************************
  351. TASSIGNMENTNODE
  352. *****************************************************************************}
  353. constructor tassignmentnode.create(l,r : tnode);
  354. begin
  355. inherited create(assignn,l,r);
  356. assigntype:=at_normal;
  357. end;
  358. function tassignmentnode.getcopy : tnode;
  359. var
  360. n : tassignmentnode;
  361. begin
  362. n:=tassignmentnode(inherited getcopy);
  363. n.assigntype:=assigntype;
  364. getcopy:=n;
  365. end;
  366. function tassignmentnode.det_resulttype:tnode;
  367. var
  368. hp,hp2 : tnode;
  369. begin
  370. result:=nil;
  371. resulttype:=voidtype;
  372. { must be made unique }
  373. if assigned(left) then
  374. begin
  375. set_unique(left);
  376. { set we the function result? }
  377. set_funcret_is_valid(left);
  378. end;
  379. resulttypepass(left);
  380. resulttypepass(right);
  381. set_varstate(left,false);
  382. set_varstate(right,true);
  383. if codegenerror then
  384. exit;
  385. { assignments to open arrays aren't allowed }
  386. if is_open_array(left.resulttype.def) then
  387. CGMessage(type_e_mismatch);
  388. { assigning nil to a dynamic array clears the array }
  389. if is_dynamic_array(left.resulttype.def) and
  390. (right.nodetype=niln) then
  391. begin
  392. hp := ctypeconvnode.create(left,voidpointertype);
  393. hp.toggleflag(nf_explizit);
  394. hp2 := crttinode.create(tstoreddef(left.resulttype.def),initrtti);
  395. hp := ccallparanode.create(hp2,ccallparanode.create(hp,nil));
  396. left:=nil;
  397. result := ccallnode.createintern('fpc_dynarray_clear',hp);
  398. exit;
  399. end;
  400. { some string functions don't need conversion, so treat them separatly }
  401. if not (
  402. is_shortstring(left.resulttype.def) and
  403. (
  404. is_shortstring(right.resulttype.def) or
  405. is_ansistring(right.resulttype.def) or
  406. is_char(right.resulttype.def)
  407. )
  408. ) then
  409. inserttypeconv(right,left.resulttype);
  410. { test if node can be assigned, properties are allowed }
  411. valid_for_assignment(left);
  412. { check if local proc/func is assigned to procvar }
  413. if right.resulttype.def.deftype=procvardef then
  414. test_local_to_procvar(tprocvardef(right.resulttype.def),left.resulttype.def);
  415. end;
  416. function tassignmentnode.pass_1 : tnode;
  417. begin
  418. result:=nil;
  419. firstpass(left);
  420. firstpass(right);
  421. if codegenerror then
  422. exit;
  423. { some string functions don't need conversion, so treat them separatly }
  424. if is_shortstring(left.resulttype.def) and
  425. (
  426. is_shortstring(right.resulttype.def) or
  427. is_ansistring(right.resulttype.def) or
  428. is_char(right.resulttype.def)
  429. ) then
  430. begin
  431. { we call STRCOPY }
  432. procinfo^.flags:=procinfo^.flags or pi_do_call;
  433. { test for s:=s+anything ... }
  434. { the problem is for
  435. s:=s+s+s;
  436. this is broken here !! }
  437. {$ifdef newoptimizations2}
  438. { the above is fixed now, but still problem with s := s + f(); if }
  439. { f modifies s (bad programming, so only enable if uncertain }
  440. { optimizations are on) (JM) }
  441. if (cs_UncertainOpts in aktglobalswitches) then
  442. begin
  443. hp := right;
  444. while hp.treetype=addn do hp:=hp.left;
  445. if equal_trees(left,hp) and
  446. not multiple_uses(left,right) then
  447. begin
  448. concat_string:=true;
  449. hp:=right;
  450. while hp.treetype=addn do
  451. begin
  452. hp.use_strconcat:=true;
  453. hp:=hp.left;
  454. end;
  455. end;
  456. end;
  457. {$endif newoptimizations2}
  458. end;
  459. registers32:=left.registers32+right.registers32;
  460. registersfpu:=max(left.registersfpu,right.registersfpu);
  461. {$ifdef SUPPORT_MMX}
  462. registersmmx:=max(left.registersmmx,right.registersmmx);
  463. {$endif SUPPORT_MMX}
  464. end;
  465. function tassignmentnode.docompare(p: tnode): boolean;
  466. begin
  467. docompare :=
  468. inherited docompare(p) and
  469. (assigntype = tassignmentnode(p).assigntype);
  470. end;
  471. {*****************************************************************************
  472. TFUNCRETNODE
  473. *****************************************************************************}
  474. constructor tfuncretnode.create(v:tsym);
  475. begin
  476. inherited create(funcretn);
  477. funcretsym:=tfuncretsym(v);
  478. end;
  479. function tfuncretnode.getcopy : tnode;
  480. var
  481. n : tfuncretnode;
  482. begin
  483. n:=tfuncretnode(inherited getcopy);
  484. n.funcretsym:=funcretsym;
  485. getcopy:=n;
  486. end;
  487. function tfuncretnode.det_resulttype:tnode;
  488. begin
  489. result:=nil;
  490. resulttype:=funcretsym.returntype;
  491. end;
  492. function tfuncretnode.pass_1 : tnode;
  493. begin
  494. result:=nil;
  495. location.loc:=LOC_REFERENCE;
  496. if ret_in_param(resulttype.def) or
  497. (lexlevel<>funcretsym.owner.symtablelevel) then
  498. registers32:=1;
  499. end;
  500. function tfuncretnode.docompare(p: tnode): boolean;
  501. begin
  502. docompare :=
  503. inherited docompare(p) and
  504. (funcretsym = tfuncretnode(p).funcretsym);
  505. end;
  506. {*****************************************************************************
  507. TARRAYCONSTRUCTORRANGENODE
  508. *****************************************************************************}
  509. constructor tarrayconstructorrangenode.create(l,r : tnode);
  510. begin
  511. inherited create(arrayconstructorrangen,l,r);
  512. end;
  513. function tarrayconstructorrangenode.det_resulttype:tnode;
  514. begin
  515. result:=nil;
  516. resulttypepass(left);
  517. resulttypepass(right);
  518. set_varstate(left,true);
  519. set_varstate(right,true);
  520. if codegenerror then
  521. exit;
  522. resulttype:=left.resulttype;
  523. end;
  524. function tarrayconstructorrangenode.pass_1 : tnode;
  525. begin
  526. firstpass(left);
  527. firstpass(right);
  528. location.loc := LOC_MEM;
  529. calcregisters(self,0,0,0);
  530. result:=nil;
  531. end;
  532. {****************************************************************************
  533. TARRAYCONSTRUCTORNODE
  534. *****************************************************************************}
  535. constructor tarrayconstructornode.create(l,r : tnode);
  536. begin
  537. inherited create(arrayconstructorn,l,r);
  538. end;
  539. function tarrayconstructornode.getcopy : tnode;
  540. var
  541. n : tarrayconstructornode;
  542. begin
  543. n:=tarrayconstructornode(inherited getcopy);
  544. result:=n;
  545. end;
  546. function tarrayconstructornode.det_resulttype:tnode;
  547. var
  548. htype : ttype;
  549. hp : tarrayconstructornode;
  550. len : longint;
  551. varia : boolean;
  552. begin
  553. result:=nil;
  554. { are we allowing array constructor? Then convert it to a set }
  555. if not allow_array_constructor then
  556. begin
  557. hp:=tarrayconstructornode(getcopy);
  558. arrayconstructor_to_set(hp);
  559. result:=hp;
  560. exit;
  561. end;
  562. { only pass left tree, right tree contains next construct if any }
  563. htype.reset;
  564. len:=0;
  565. varia:=false;
  566. if assigned(left) then
  567. begin
  568. hp:=self;
  569. while assigned(hp) do
  570. begin
  571. resulttypepass(hp.left);
  572. set_varstate(hp.left,true);
  573. if (htype.def=nil) then
  574. htype:=hp.left.resulttype
  575. else
  576. begin
  577. if ((nf_novariaallowed in flags) or (not varia)) and
  578. (not is_equal(htype.def,hp.left.resulttype.def)) then
  579. begin
  580. varia:=true;
  581. end;
  582. end;
  583. inc(len);
  584. hp:=tarrayconstructornode(hp.right);
  585. end;
  586. end;
  587. if not assigned(htype.def) then
  588. htype:=voidtype;
  589. resulttype.setdef(tarraydef.create(0,len-1,s32bittype));
  590. tarraydef(resulttype.def).elementtype:=htype;
  591. tarraydef(resulttype.def).IsConstructor:=true;
  592. tarraydef(resulttype.def).IsVariant:=varia;
  593. end;
  594. procedure tarrayconstructornode.force_type(tt:ttype);
  595. var
  596. hp : tarrayconstructornode;
  597. begin
  598. tarraydef(resulttype.def).elementtype:=tt;
  599. tarraydef(resulttype.def).IsConstructor:=true;
  600. tarraydef(resulttype.def).IsVariant:=false;
  601. if assigned(left) then
  602. begin
  603. hp:=self;
  604. while assigned(hp) do
  605. begin
  606. inserttypeconv(hp.left,tt);
  607. hp:=tarrayconstructornode(hp.right);
  608. end;
  609. end;
  610. end;
  611. function tarrayconstructornode.pass_1 : tnode;
  612. var
  613. thp,
  614. chp,
  615. hp : tarrayconstructornode;
  616. dovariant : boolean;
  617. htype : ttype;
  618. orgflags : tnodeflagset;
  619. begin
  620. dovariant:=(nf_forcevaria in flags) or tarraydef(resulttype.def).isvariant;
  621. result:=nil;
  622. { only pass left tree, right tree contains next construct if any }
  623. if assigned(left) then
  624. begin
  625. hp:=self;
  626. while assigned(hp) do
  627. begin
  628. firstpass(hp.left);
  629. { Insert typeconvs for array of const }
  630. if dovariant then
  631. begin
  632. case hp.left.resulttype.def.deftype of
  633. enumdef :
  634. begin
  635. hp.left:=ctypeconvnode.create(hp.left,s32bittype);
  636. firstpass(hp.left);
  637. end;
  638. orddef :
  639. begin
  640. if is_integer(hp.left.resulttype.def) and
  641. not(is_64bitint(hp.left.resulttype.def)) then
  642. begin
  643. hp.left:=ctypeconvnode.create(hp.left,s32bittype);
  644. firstpass(hp.left);
  645. end;
  646. end;
  647. floatdef :
  648. begin
  649. hp.left:=ctypeconvnode.create(hp.left,pbestrealtype^);
  650. firstpass(hp.left);
  651. end;
  652. stringdef :
  653. begin
  654. if nf_cargs in flags then
  655. begin
  656. hp.left:=ctypeconvnode.create(hp.left,charpointertype);
  657. firstpass(hp.left);
  658. end;
  659. end;
  660. procvardef :
  661. begin
  662. hp.left:=ctypeconvnode.create(hp.left,voidpointertype);
  663. firstpass(hp.left);
  664. end;
  665. pointerdef,
  666. classrefdef,
  667. objectdef : ;
  668. else
  669. CGMessagePos1(hp.left.fileinfo,type_e_wrong_type_in_array_constructor,hp.left.resulttype.def.typename);
  670. end;
  671. end;
  672. hp:=tarrayconstructornode(hp.right);
  673. end;
  674. { swap the tree for cargs }
  675. if (nf_cargs in flags) and (not(nf_cargswap in flags)) then
  676. begin
  677. chp:=nil;
  678. { save resulttype }
  679. htype:=resulttype;
  680. { we need a copy here, because self is destroyed }
  681. { by firstpass later }
  682. hp:=tarrayconstructornode(getcopy);
  683. { we also need a copy of the nf_ forcevaria flag to restore }
  684. { later) (JM) }
  685. orgflags := flags * [nf_forcevaria];
  686. while assigned(hp) do
  687. begin
  688. thp:=tarrayconstructornode(hp.right);
  689. hp.right:=chp;
  690. chp:=hp;
  691. hp:=thp;
  692. end;
  693. chp.flags := chp.flags+orgflags;
  694. include(chp.flags,nf_cargswap);
  695. chp.location.loc:=LOC_MEM;
  696. calcregisters(chp,0,0,0);
  697. chp.resulttype:=htype;
  698. result:=chp;
  699. exit;
  700. end;
  701. end;
  702. location.loc:=LOC_MEM;
  703. calcregisters(self,0,0,0);
  704. end;
  705. function tarrayconstructornode.docompare(p: tnode): boolean;
  706. begin
  707. docompare :=
  708. inherited docompare(p);
  709. end;
  710. {*****************************************************************************
  711. TTYPENODE
  712. *****************************************************************************}
  713. constructor ttypenode.create(t : ttype);
  714. begin
  715. inherited create(typen);
  716. restype:=t;
  717. allowed:=false;
  718. end;
  719. function ttypenode.det_resulttype:tnode;
  720. begin
  721. result:=nil;
  722. resulttype:=restype;
  723. { check if it's valid }
  724. if restype.def.deftype = errordef then
  725. CGMessage(cg_e_illegal_expression);
  726. end;
  727. function ttypenode.pass_1 : tnode;
  728. begin
  729. result:=nil;
  730. { a typenode can't generate code, so we give here
  731. an error. Else it'll be an abstract error in pass_2.
  732. Only when the allowed flag is set we don't generate
  733. an error }
  734. if not allowed then
  735. Message(parser_e_no_type_not_allowed_here);
  736. end;
  737. function ttypenode.docompare(p: tnode): boolean;
  738. begin
  739. docompare :=
  740. inherited docompare(p);
  741. end;
  742. {*****************************************************************************
  743. TRTTINODE
  744. *****************************************************************************}
  745. constructor trttinode.create(def:tstoreddef;rt:trttitype);
  746. begin
  747. inherited create(rttin);
  748. rttidef:=def;
  749. rttitype:=rt;
  750. end;
  751. function trttinode.getcopy : tnode;
  752. var
  753. n : trttinode;
  754. begin
  755. n:=trttinode(inherited getcopy);
  756. n.rttidef:=rttidef;
  757. n.rttitype:=rttitype;
  758. result:=n;
  759. end;
  760. function trttinode.det_resulttype:tnode;
  761. begin
  762. { rtti information will be returned as a void pointer }
  763. result:=nil;
  764. resulttype:=voidpointertype;
  765. end;
  766. function trttinode.pass_1 : tnode;
  767. begin
  768. result:=nil;
  769. location.loc:=LOC_MEM;
  770. end;
  771. function trttinode.docompare(p: tnode): boolean;
  772. begin
  773. docompare :=
  774. inherited docompare(p) and
  775. (rttidef = trttinode(p).rttidef) and
  776. (rttitype = trttinode(p).rttitype);
  777. end;
  778. procedure trttinode.pass_2;
  779. begin
  780. reset_reference(location.reference);
  781. location.loc:=LOC_MEM;
  782. location.reference.symbol:=rttidef.get_rtti_label(rttitype);
  783. end;
  784. begin
  785. cloadnode:=tloadnode;
  786. cassignmentnode:=tassignmentnode;
  787. cfuncretnode:=tfuncretnode;
  788. carrayconstructorrangenode:=tarrayconstructorrangenode;
  789. carrayconstructornode:=tarrayconstructornode;
  790. ctypenode:=ttypenode;
  791. crttinode:=trttinode;
  792. end.
  793. {
  794. $Log$
  795. Revision 1.32 2002-01-19 11:52:32 peter
  796. * dynarr:=nil support added
  797. Revision 1.31 2001/12/28 15:02:00 jonas
  798. * fixed web bug 1684 (it already didn't crash anymore, but it also didn't
  799. generate an error) ("merged")
  800. Revision 1.30 2001/11/07 13:52:52 jonas
  801. * only save/restore nf_forcevaria flag when reversing order of
  802. arrayconstructor elements, since the other flags are element specific
  803. Revision 1.29 2001/11/02 22:58:02 peter
  804. * procsym definition rewrite
  805. Revision 1.28 2001/10/31 17:34:20 jonas
  806. * fixed web bug 1651
  807. Revision 1.27 2001/10/28 17:22:25 peter
  808. * allow assignment of overloaded procedures to procvars when we know
  809. which procedure to take
  810. Revision 1.26 2001/10/12 13:51:51 jonas
  811. * fixed internalerror(10) due to previous fpu overflow fixes ("merged")
  812. * fixed bug in n386add (introduced after compilerproc changes for string
  813. operations) where calcregisters wasn't called for shortstring addnodes
  814. * NOTE: from now on, the location of a binary node must now always be set
  815. before you call calcregisters() for it
  816. Revision 1.25 2001/09/02 21:12:07 peter
  817. * move class of definitions into type section for delphi
  818. Revision 1.24 2001/08/30 15:48:34 jonas
  819. * fix from Peter for getting correct symtableentry for funcret loads
  820. Revision 1.23 2001/08/26 13:36:41 florian
  821. * some cg reorganisation
  822. * some PPC updates
  823. Revision 1.22 2001/08/12 22:11:52 peter
  824. * errordef.typesym is not updated anymore
  825. Revision 1.21 2001/08/06 21:40:47 peter
  826. * funcret moved from tprocinfo to tprocdef
  827. Revision 1.20 2001/07/30 20:52:25 peter
  828. * fixed array constructor passing with type conversions
  829. Revision 1.19 2001/06/04 18:07:47 peter
  830. * remove unused typenode for procvar load. Don't know what happened why
  831. this code was not there already with revision 1.17.
  832. Revision 1.18 2001/06/04 11:48:01 peter
  833. * better const to var checking
  834. Revision 1.17 2001/05/19 21:19:57 peter
  835. * remove unused typenode for procvars to prevent error
  836. * typenode.allowed flag to allow a typenode
  837. Revision 1.16 2001/05/09 19:57:51 peter
  838. * typenode doesn't generate code, give error in pass_1 instead of
  839. getting an abstract methode runtime error
  840. Revision 1.15 2001/04/14 14:06:31 peter
  841. * move more code from loadnode.pass_1 to det_resulttype
  842. Revision 1.14 2001/04/13 01:22:10 peter
  843. * symtable change to classes
  844. * range check generation and errors fixed, make cycle DEBUG=1 works
  845. * memory leaks fixed
  846. Revision 1.13 2001/04/05 21:03:08 peter
  847. * array constructor fix
  848. Revision 1.12 2001/04/04 22:42:40 peter
  849. * move constant folding into det_resulttype
  850. Revision 1.11 2001/04/02 21:20:31 peter
  851. * resulttype rewrite
  852. Revision 1.10 2000/12/31 11:14:10 jonas
  853. + implemented/fixed docompare() mathods for all nodes (not tested)
  854. + nopt.pas, nadd.pas, i386/n386opt.pas: optimized nodes for adding strings
  855. and constant strings/chars together
  856. * n386add.pas: don't copy temp strings (of size 256) to another temp string
  857. when adding
  858. Revision 1.9 2000/11/29 00:30:33 florian
  859. * unused units removed from uses clause
  860. * some changes for widestrings
  861. Revision 1.8 2000/11/04 14:25:20 florian
  862. + merged Attila's changes for interfaces, not tested yet
  863. Revision 1.7 2000/10/31 22:02:49 peter
  864. * symtable splitted, no real code changes
  865. Revision 1.6 2000/10/14 10:14:50 peter
  866. * moehrendorf oct 2000 rewrite
  867. Revision 1.5 2000/10/01 19:48:24 peter
  868. * lot of compile updates for cg11
  869. Revision 1.4 2000/09/28 19:49:52 florian
  870. *** empty log message ***
  871. Revision 1.3 2000/09/27 18:14:31 florian
  872. * fixed a lot of syntax errors in the n*.pas stuff
  873. Revision 1.2 2000/09/25 15:37:14 florian
  874. * more fixes
  875. Revision 1.1 2000/09/25 14:55:05 florian
  876. * initial revision
  877. }