nld.pas 29 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896
  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. symbase,symtype,symsym;
  24. type
  25. tloadnode = class(tunarynode)
  26. symtableentry : tsym;
  27. symtable : tsymtable;
  28. constructor create(v : tsym;st : tsymtable);virtual;
  29. procedure set_mp(p:tnode);
  30. function getcopy : tnode;override;
  31. function pass_1 : tnode;override;
  32. function det_resulttype:tnode;override;
  33. function docompare(p: tnode): boolean; override;
  34. end;
  35. tloadnodeclass = class of tloadnode;
  36. { different assignment types }
  37. tassigntype = (at_normal,at_plus,at_minus,at_star,at_slash);
  38. tassignmentnode = class(tbinarynode)
  39. assigntype : tassigntype;
  40. constructor create(l,r : tnode);virtual;
  41. function getcopy : tnode;override;
  42. function pass_1 : tnode;override;
  43. function det_resulttype:tnode;override;
  44. function docompare(p: tnode): boolean; override;
  45. end;
  46. tassignmentnodeclass = class of tassignmentnode;
  47. tfuncretnode = class(tnode)
  48. funcretsym : tfuncretsym;
  49. constructor create(v:tsym);virtual;
  50. function getcopy : tnode;override;
  51. function pass_1 : tnode;override;
  52. function det_resulttype:tnode;override;
  53. function docompare(p: tnode): boolean; override;
  54. end;
  55. tfuncretnodeclass = class of tfuncretnode;
  56. tarrayconstructorrangenode = class(tbinarynode)
  57. constructor create(l,r : tnode);virtual;
  58. function pass_1 : tnode;override;
  59. function det_resulttype:tnode;override;
  60. end;
  61. tarrayconstructorrangenodeclass = class of tarrayconstructorrangenode;
  62. tarrayconstructornode = class(tbinarynode)
  63. constructor create(l,r : tnode);virtual;
  64. function getcopy : tnode;override;
  65. function pass_1 : tnode;override;
  66. function det_resulttype:tnode;override;
  67. function docompare(p: tnode): boolean; override;
  68. procedure force_type(tt:ttype);
  69. end;
  70. tarrayconstructornodeclass = class of tarrayconstructornode;
  71. ttypenode = class(tnode)
  72. allowed : boolean;
  73. restype : ttype;
  74. constructor create(t : ttype);virtual;
  75. function pass_1 : tnode;override;
  76. function det_resulttype:tnode;override;
  77. function docompare(p: tnode): boolean; override;
  78. end;
  79. ttypenodeclass = class of ttypenode;
  80. var
  81. cloadnode : tloadnodeclass;
  82. cassignmentnode : tassignmentnodeclass;
  83. cfuncretnode : tfuncretnodeclass;
  84. carrayconstructorrangenode : tarrayconstructorrangenodeclass;
  85. carrayconstructornode : tarrayconstructornodeclass;
  86. ctypenode : ttypenodeclass;
  87. implementation
  88. uses
  89. cutils,verbose,globtype,globals,systems,
  90. symconst,symdef,symtable,types,
  91. htypechk,pass_1,
  92. ncnv,nmem,cpubase,tgcpu,cgbase
  93. ;
  94. {*****************************************************************************
  95. TLOADNODE
  96. *****************************************************************************}
  97. constructor tloadnode.create(v : tsym;st : tsymtable);
  98. begin
  99. inherited create(loadn,nil);
  100. if not assigned(v) then
  101. internalerror(200108121);
  102. symtableentry:=v;
  103. symtable:=st;
  104. end;
  105. procedure tloadnode.set_mp(p:tnode);
  106. begin
  107. left:=p;
  108. end;
  109. function tloadnode.getcopy : tnode;
  110. var
  111. n : tloadnode;
  112. begin
  113. n:=tloadnode(inherited getcopy);
  114. n.symtable:=symtable;
  115. n.symtableentry:=symtableentry;
  116. result:=n;
  117. end;
  118. function tloadnode.det_resulttype:tnode;
  119. var
  120. p1 : tnode;
  121. p : pprocinfo;
  122. begin
  123. result:=nil;
  124. { optimize simple with loadings }
  125. if (symtable.symtabletype=withsymtable) and
  126. (twithsymtable(symtable).direct_with) and
  127. (symtableentry.typ=varsym) then
  128. begin
  129. p1:=tnode(twithsymtable(symtable).withrefnode).getcopy;
  130. p1:=csubscriptnode.create(tvarsym(symtableentry),p1);
  131. left:=nil;
  132. result:=p1;
  133. exit;
  134. end;
  135. { handle first absolute as it will replace the symtableentry }
  136. if symtableentry.typ=absolutesym then
  137. begin
  138. { force the resulttype to the type of the absolute }
  139. resulttype:=tabsolutesym(symtableentry).vartype;
  140. { replace the symtableentry when it points to a var, else
  141. we are finished }
  142. if tabsolutesym(symtableentry).abstyp=tovar then
  143. begin
  144. symtableentry:=tabsolutesym(symtableentry).ref;
  145. symtable:=symtableentry.owner;
  146. include(flags,nf_absolute);
  147. end
  148. else
  149. exit;
  150. end;
  151. case symtableentry.typ of
  152. funcretsym :
  153. begin
  154. { find the main funcret for the function }
  155. p:=procinfo;
  156. while assigned(p) do
  157. begin
  158. if assigned(p^.procdef.funcretsym) and
  159. ((tfuncretsym(symtableentry)=p^.procdef.resultfuncretsym) or
  160. (tfuncretsym(symtableentry)=p^.procdef.funcretsym)) then
  161. begin
  162. symtableentry:=p^.procdef.funcretsym;
  163. break;
  164. end;
  165. p:=p^.parent;
  166. end;
  167. { generate funcretnode }
  168. p1:=cfuncretnode.create(symtableentry);
  169. resulttypepass(p1);
  170. { if it's refered as absolute then we need to have the
  171. type of the absolute instead of the function return,
  172. the function return is then also assigned }
  173. if nf_absolute in flags then
  174. begin
  175. tfuncretsym(symtableentry).funcretstate:=vs_assigned;
  176. p1.resulttype:=resulttype;
  177. end;
  178. left:=nil;
  179. result:=p1;
  180. end;
  181. constsym:
  182. begin
  183. if tconstsym(symtableentry).consttyp=constresourcestring then
  184. resulttype:=cansistringtype
  185. else
  186. internalerror(22799);
  187. end;
  188. varsym :
  189. begin
  190. { if it's refered by absolute then it's used }
  191. if nf_absolute in flags then
  192. tvarsym(symtableentry).varstate:=vs_used
  193. else
  194. resulttype:=tvarsym(symtableentry).vartype;
  195. end;
  196. typedconstsym :
  197. if not(nf_absolute in flags) then
  198. resulttype:=ttypedconstsym(symtableentry).typedconsttype;
  199. procsym :
  200. begin
  201. if assigned(tprocsym(symtableentry).definition.nextoverloaded) then
  202. CGMessage(parser_e_no_overloaded_procvars);
  203. resulttype.setdef(tprocsym(symtableentry).definition);
  204. { if the owner of the procsym is a object, }
  205. { left must be set, if left isn't set }
  206. { it can be only self }
  207. { this code is only used in TP procvar mode }
  208. if (m_tp_procvar in aktmodeswitches) and
  209. not(assigned(left)) and
  210. (tprocsym(symtableentry).owner.symtabletype=objectsymtable) then
  211. begin
  212. left:=cselfnode.create(tobjectdef(symtableentry.owner.defowner));
  213. end;
  214. { process methodpointer }
  215. if assigned(left) then
  216. begin
  217. { if only typenode then remove }
  218. if left.nodetype=typen then
  219. begin
  220. left.free;
  221. left:=nil;
  222. end
  223. else
  224. resulttypepass(left);
  225. end;
  226. end;
  227. else
  228. internalerror(200104141);
  229. end;
  230. end;
  231. function tloadnode.pass_1 : tnode;
  232. begin
  233. result:=nil;
  234. location.loc:=LOC_REFERENCE;
  235. registers32:=0;
  236. registersfpu:=0;
  237. {$ifdef SUPPORT_MMX}
  238. registersmmx:=0;
  239. {$endif SUPPORT_MMX}
  240. case symtableentry.typ of
  241. absolutesym :
  242. ;
  243. funcretsym :
  244. internalerror(200104142);
  245. constsym:
  246. begin
  247. if tconstsym(symtableentry).consttyp=constresourcestring then
  248. begin
  249. { we use ansistrings so no fast exit here }
  250. if assigned(procinfo) then
  251. procinfo^.no_fast_exit:=true;
  252. location.loc:=LOC_MEM;
  253. end;
  254. end;
  255. varsym :
  256. begin
  257. if (symtable.symtabletype in [parasymtable,localsymtable]) and
  258. (lexlevel>symtable.symtablelevel) then
  259. begin
  260. { if the variable is in an other stackframe then we need
  261. a register to dereference }
  262. if (symtable.symtablelevel)>0 then
  263. begin
  264. registers32:=1;
  265. { further, the variable can't be put into a register }
  266. tvarsym(symtableentry).varoptions:=
  267. tvarsym(symtableentry).varoptions-[vo_fpuregable,vo_regable];
  268. end;
  269. end;
  270. if (tvarsym(symtableentry).varspez=vs_const) then
  271. location.loc:=LOC_MEM;
  272. { we need a register for call by reference parameters }
  273. if (tvarsym(symtableentry).varspez in [vs_var,vs_out]) or
  274. ((tvarsym(symtableentry).varspez=vs_const) and
  275. push_addr_param(tvarsym(symtableentry).vartype.def)) or
  276. { call by value open arrays are also indirect addressed }
  277. is_open_array(tvarsym(symtableentry).vartype.def) then
  278. registers32:=1;
  279. if symtable.symtabletype=withsymtable then
  280. inc(registers32);
  281. if ([vo_is_thread_var,vo_is_dll_var]*tvarsym(symtableentry).varoptions)<>[] then
  282. registers32:=1;
  283. { count variable references }
  284. { this will create problem with local var set by
  285. under_procedures
  286. if (assigned(tvarsym(symtableentry).owner) and assigned(aktprocsym)
  287. and ((tvarsym(symtableentry).owner = aktprocsym.definition.localst)
  288. or (tvarsym(symtableentry).owner = aktprocsym.definition.localst))) then }
  289. if t_times<1 then
  290. inc(tvarsym(symtableentry).refs)
  291. else
  292. inc(tvarsym(symtableentry).refs,t_times);
  293. end;
  294. typedconstsym :
  295. ;
  296. procsym :
  297. begin
  298. { method pointer ? }
  299. if assigned(left) then
  300. begin
  301. firstpass(left);
  302. registers32:=max(registers32,left.registers32);
  303. registersfpu:=max(registersfpu,left.registersfpu);
  304. {$ifdef SUPPORT_MMX}
  305. registersmmx:=max(registersmmx,left.registersmmx);
  306. {$endif SUPPORT_MMX}
  307. end;
  308. end;
  309. else
  310. internalerror(200104143);
  311. end;
  312. end;
  313. function tloadnode.docompare(p: tnode): boolean;
  314. begin
  315. docompare :=
  316. inherited docompare(p) and
  317. (symtableentry = tloadnode(p).symtableentry) and
  318. (symtable = tloadnode(p).symtable);
  319. end;
  320. {*****************************************************************************
  321. TASSIGNMENTNODE
  322. *****************************************************************************}
  323. constructor tassignmentnode.create(l,r : tnode);
  324. begin
  325. inherited create(assignn,l,r);
  326. assigntype:=at_normal;
  327. end;
  328. function tassignmentnode.getcopy : tnode;
  329. var
  330. n : tassignmentnode;
  331. begin
  332. n:=tassignmentnode(inherited getcopy);
  333. n.assigntype:=assigntype;
  334. getcopy:=n;
  335. end;
  336. function tassignmentnode.det_resulttype:tnode;
  337. begin
  338. result:=nil;
  339. resulttype:=voidtype;
  340. { must be made unique }
  341. if assigned(left) then
  342. begin
  343. set_unique(left);
  344. { set we the function result? }
  345. set_funcret_is_valid(left);
  346. end;
  347. resulttypepass(left);
  348. resulttypepass(right);
  349. set_varstate(left,false);
  350. set_varstate(right,true);
  351. if codegenerror then
  352. exit;
  353. { assignments to open arrays aren't allowed }
  354. if is_open_array(left.resulttype.def) then
  355. CGMessage(type_e_mismatch);
  356. { some string functions don't need conversion, so treat them separatly }
  357. if not (
  358. is_shortstring(left.resulttype.def) and
  359. (
  360. is_shortstring(right.resulttype.def) or
  361. is_ansistring(right.resulttype.def) or
  362. is_char(right.resulttype.def)
  363. )
  364. ) then
  365. inserttypeconv(right,left.resulttype);
  366. { test if node can be assigned, properties are allowed }
  367. valid_for_assignment(left);
  368. { check if local proc/func is assigned to procvar }
  369. if right.resulttype.def.deftype=procvardef then
  370. test_local_to_procvar(tprocvardef(right.resulttype.def),left.resulttype.def);
  371. end;
  372. function tassignmentnode.pass_1 : tnode;
  373. begin
  374. result:=nil;
  375. firstpass(left);
  376. firstpass(right);
  377. if codegenerror then
  378. exit;
  379. { some string functions don't need conversion, so treat them separatly }
  380. if is_shortstring(left.resulttype.def) and
  381. (
  382. is_shortstring(right.resulttype.def) or
  383. is_ansistring(right.resulttype.def) or
  384. is_char(right.resulttype.def)
  385. ) then
  386. begin
  387. { we call STRCOPY }
  388. procinfo^.flags:=procinfo^.flags or pi_do_call;
  389. { test for s:=s+anything ... }
  390. { the problem is for
  391. s:=s+s+s;
  392. this is broken here !! }
  393. {$ifdef newoptimizations2}
  394. { the above is fixed now, but still problem with s := s + f(); if }
  395. { f modifies s (bad programming, so only enable if uncertain }
  396. { optimizations are on) (JM) }
  397. if (cs_UncertainOpts in aktglobalswitches) then
  398. begin
  399. hp := right;
  400. while hp.treetype=addn do hp:=hp.left;
  401. if equal_trees(left,hp) and
  402. not multiple_uses(left,right) then
  403. begin
  404. concat_string:=true;
  405. hp:=right;
  406. while hp.treetype=addn do
  407. begin
  408. hp.use_strconcat:=true;
  409. hp:=hp.left;
  410. end;
  411. end;
  412. end;
  413. {$endif newoptimizations2}
  414. end;
  415. registers32:=left.registers32+right.registers32;
  416. registersfpu:=max(left.registersfpu,right.registersfpu);
  417. {$ifdef SUPPORT_MMX}
  418. registersmmx:=max(left.registersmmx,right.registersmmx);
  419. {$endif SUPPORT_MMX}
  420. end;
  421. function tassignmentnode.docompare(p: tnode): boolean;
  422. begin
  423. docompare :=
  424. inherited docompare(p) and
  425. (assigntype = tassignmentnode(p).assigntype);
  426. end;
  427. {*****************************************************************************
  428. TFUNCRETNODE
  429. *****************************************************************************}
  430. constructor tfuncretnode.create(v:tsym);
  431. begin
  432. inherited create(funcretn);
  433. funcretsym:=tfuncretsym(v);
  434. end;
  435. function tfuncretnode.getcopy : tnode;
  436. var
  437. n : tfuncretnode;
  438. begin
  439. n:=tfuncretnode(inherited getcopy);
  440. n.funcretsym:=funcretsym;
  441. getcopy:=n;
  442. end;
  443. function tfuncretnode.det_resulttype:tnode;
  444. begin
  445. result:=nil;
  446. resulttype:=funcretsym.returntype;
  447. end;
  448. function tfuncretnode.pass_1 : tnode;
  449. begin
  450. result:=nil;
  451. location.loc:=LOC_REFERENCE;
  452. if ret_in_param(resulttype.def) or
  453. (lexlevel<>funcretsym.owner.symtablelevel) then
  454. registers32:=1;
  455. end;
  456. function tfuncretnode.docompare(p: tnode): boolean;
  457. begin
  458. docompare :=
  459. inherited docompare(p) and
  460. (funcretsym = tfuncretnode(p).funcretsym);
  461. end;
  462. {*****************************************************************************
  463. TARRAYCONSTRUCTORRANGENODE
  464. *****************************************************************************}
  465. constructor tarrayconstructorrangenode.create(l,r : tnode);
  466. begin
  467. inherited create(arrayconstructorrangen,l,r);
  468. end;
  469. function tarrayconstructorrangenode.det_resulttype:tnode;
  470. begin
  471. result:=nil;
  472. resulttypepass(left);
  473. resulttypepass(right);
  474. set_varstate(left,true);
  475. set_varstate(right,true);
  476. if codegenerror then
  477. exit;
  478. resulttype:=left.resulttype;
  479. end;
  480. function tarrayconstructorrangenode.pass_1 : tnode;
  481. begin
  482. firstpass(left);
  483. firstpass(right);
  484. location.loc := LOC_MEM;
  485. calcregisters(self,0,0,0);
  486. result:=nil;
  487. end;
  488. {****************************************************************************
  489. TARRAYCONSTRUCTORNODE
  490. *****************************************************************************}
  491. constructor tarrayconstructornode.create(l,r : tnode);
  492. begin
  493. inherited create(arrayconstructorn,l,r);
  494. end;
  495. function tarrayconstructornode.getcopy : tnode;
  496. var
  497. n : tarrayconstructornode;
  498. begin
  499. n:=tarrayconstructornode(inherited getcopy);
  500. result:=n;
  501. end;
  502. function tarrayconstructornode.det_resulttype:tnode;
  503. var
  504. htype : ttype;
  505. hp : tarrayconstructornode;
  506. len : longint;
  507. varia : boolean;
  508. begin
  509. result:=nil;
  510. { are we allowing array constructor? Then convert it to a set }
  511. if not allow_array_constructor then
  512. begin
  513. hp:=tarrayconstructornode(getcopy);
  514. arrayconstructor_to_set(hp);
  515. result:=hp;
  516. exit;
  517. end;
  518. { only pass left tree, right tree contains next construct if any }
  519. htype.reset;
  520. len:=0;
  521. varia:=false;
  522. if assigned(left) then
  523. begin
  524. hp:=self;
  525. while assigned(hp) do
  526. begin
  527. resulttypepass(hp.left);
  528. set_varstate(hp.left,true);
  529. if (htype.def=nil) then
  530. htype:=hp.left.resulttype
  531. else
  532. begin
  533. if ((nf_novariaallowed in flags) or (not varia)) and
  534. (not is_equal(htype.def,hp.left.resulttype.def)) then
  535. begin
  536. varia:=true;
  537. end;
  538. end;
  539. inc(len);
  540. hp:=tarrayconstructornode(hp.right);
  541. end;
  542. end;
  543. if not assigned(htype.def) then
  544. htype:=voidtype;
  545. resulttype.setdef(tarraydef.create(0,len-1,s32bittype));
  546. tarraydef(resulttype.def).elementtype:=htype;
  547. tarraydef(resulttype.def).IsConstructor:=true;
  548. tarraydef(resulttype.def).IsVariant:=varia;
  549. end;
  550. procedure tarrayconstructornode.force_type(tt:ttype);
  551. var
  552. hp : tarrayconstructornode;
  553. begin
  554. tarraydef(resulttype.def).elementtype:=tt;
  555. tarraydef(resulttype.def).IsConstructor:=true;
  556. tarraydef(resulttype.def).IsVariant:=false;
  557. if assigned(left) then
  558. begin
  559. hp:=self;
  560. while assigned(hp) do
  561. begin
  562. inserttypeconv(hp.left,tt);
  563. hp:=tarrayconstructornode(hp.right);
  564. end;
  565. end;
  566. end;
  567. function tarrayconstructornode.pass_1 : tnode;
  568. var
  569. thp,
  570. chp,
  571. hp : tarrayconstructornode;
  572. dovariant : boolean;
  573. htype : ttype;
  574. begin
  575. dovariant:=(nf_forcevaria in flags) or tarraydef(resulttype.def).isvariant;
  576. result:=nil;
  577. { only pass left tree, right tree contains next construct if any }
  578. if assigned(left) then
  579. begin
  580. hp:=self;
  581. while assigned(hp) do
  582. begin
  583. firstpass(hp.left);
  584. { Insert typeconvs for array of const }
  585. if dovariant then
  586. begin
  587. case hp.left.resulttype.def.deftype of
  588. enumdef :
  589. begin
  590. hp.left:=ctypeconvnode.create(hp.left,s32bittype);
  591. firstpass(hp.left);
  592. end;
  593. orddef :
  594. begin
  595. if is_integer(hp.left.resulttype.def) and
  596. not(is_64bitint(hp.left.resulttype.def)) then
  597. begin
  598. hp.left:=ctypeconvnode.create(hp.left,s32bittype);
  599. firstpass(hp.left);
  600. end;
  601. end;
  602. floatdef :
  603. begin
  604. hp.left:=ctypeconvnode.create(hp.left,pbestrealtype^);
  605. firstpass(hp.left);
  606. end;
  607. stringdef :
  608. begin
  609. if nf_cargs in flags then
  610. begin
  611. hp.left:=ctypeconvnode.create(hp.left,charpointertype);
  612. firstpass(hp.left);
  613. end;
  614. end;
  615. procvardef :
  616. begin
  617. hp.left:=ctypeconvnode.create(hp.left,voidpointertype);
  618. firstpass(hp.left);
  619. end;
  620. pointerdef,
  621. classrefdef,
  622. objectdef : ;
  623. else
  624. CGMessagePos1(hp.left.fileinfo,type_e_wrong_type_in_array_constructor,hp.left.resulttype.def.typename);
  625. end;
  626. end;
  627. hp:=tarrayconstructornode(hp.right);
  628. end;
  629. { swap the tree for cargs }
  630. if (nf_cargs in flags) and (not(nf_cargswap in flags)) then
  631. begin
  632. chp:=nil;
  633. { save resulttype }
  634. htype:=resulttype;
  635. { we need a copy here, because self is destroyed }
  636. { by firstpass later }
  637. hp:=tarrayconstructornode(getcopy);
  638. while assigned(hp) do
  639. begin
  640. thp:=tarrayconstructornode(hp.right);
  641. hp.right:=chp;
  642. chp:=hp;
  643. hp:=thp;
  644. end;
  645. include(chp.flags,nf_cargs);
  646. include(chp.flags,nf_cargswap);
  647. chp.location.loc:=LOC_MEM;
  648. calcregisters(chp,0,0,0);
  649. chp.resulttype:=htype;
  650. result:=chp;
  651. exit;
  652. end;
  653. end;
  654. location.loc:=LOC_MEM;
  655. calcregisters(self,0,0,0);
  656. end;
  657. function tarrayconstructornode.docompare(p: tnode): boolean;
  658. begin
  659. docompare :=
  660. inherited docompare(p);
  661. end;
  662. {*****************************************************************************
  663. TTYPENODE
  664. *****************************************************************************}
  665. constructor ttypenode.create(t : ttype);
  666. begin
  667. inherited create(typen);
  668. restype:=t;
  669. allowed:=false;
  670. end;
  671. function ttypenode.det_resulttype:tnode;
  672. begin
  673. result:=nil;
  674. resulttype:=restype;
  675. end;
  676. function ttypenode.pass_1 : tnode;
  677. begin
  678. result:=nil;
  679. { a typenode can't generate code, so we give here
  680. an error. Else it'll be an abstract error in pass_2.
  681. Only when the allowed flag is set we don't generate
  682. an error }
  683. if not allowed then
  684. Message(parser_e_no_type_not_allowed_here);
  685. end;
  686. function ttypenode.docompare(p: tnode): boolean;
  687. begin
  688. docompare :=
  689. inherited docompare(p);
  690. end;
  691. begin
  692. cloadnode:=tloadnode;
  693. cassignmentnode:=tassignmentnode;
  694. cfuncretnode:=tfuncretnode;
  695. carrayconstructorrangenode:=tarrayconstructorrangenode;
  696. carrayconstructornode:=tarrayconstructornode;
  697. ctypenode:=ttypenode;
  698. end.
  699. {
  700. $Log$
  701. Revision 1.26 2001-10-12 13:51:51 jonas
  702. * fixed internalerror(10) due to previous fpu overflow fixes ("merged")
  703. * fixed bug in n386add (introduced after compilerproc changes for string
  704. operations) where calcregisters wasn't called for shortstring addnodes
  705. * NOTE: from now on, the location of a binary node must now always be set
  706. before you call calcregisters() for it
  707. Revision 1.25 2001/09/02 21:12:07 peter
  708. * move class of definitions into type section for delphi
  709. Revision 1.24 2001/08/30 15:48:34 jonas
  710. * fix from Peter for getting correct symtableentry for funcret loads
  711. Revision 1.23 2001/08/26 13:36:41 florian
  712. * some cg reorganisation
  713. * some PPC updates
  714. Revision 1.22 2001/08/12 22:11:52 peter
  715. * errordef.typesym is not updated anymore
  716. Revision 1.21 2001/08/06 21:40:47 peter
  717. * funcret moved from tprocinfo to tprocdef
  718. Revision 1.20 2001/07/30 20:52:25 peter
  719. * fixed array constructor passing with type conversions
  720. Revision 1.19 2001/06/04 18:07:47 peter
  721. * remove unused typenode for procvar load. Don't know what happened why
  722. this code was not there already with revision 1.17.
  723. Revision 1.18 2001/06/04 11:48:01 peter
  724. * better const to var checking
  725. Revision 1.17 2001/05/19 21:19:57 peter
  726. * remove unused typenode for procvars to prevent error
  727. * typenode.allowed flag to allow a typenode
  728. Revision 1.16 2001/05/09 19:57:51 peter
  729. * typenode doesn't generate code, give error in pass_1 instead of
  730. getting an abstract methode runtime error
  731. Revision 1.15 2001/04/14 14:06:31 peter
  732. * move more code from loadnode.pass_1 to det_resulttype
  733. Revision 1.14 2001/04/13 01:22:10 peter
  734. * symtable change to classes
  735. * range check generation and errors fixed, make cycle DEBUG=1 works
  736. * memory leaks fixed
  737. Revision 1.13 2001/04/05 21:03:08 peter
  738. * array constructor fix
  739. Revision 1.12 2001/04/04 22:42:40 peter
  740. * move constant folding into det_resulttype
  741. Revision 1.11 2001/04/02 21:20:31 peter
  742. * resulttype rewrite
  743. Revision 1.10 2000/12/31 11:14:10 jonas
  744. + implemented/fixed docompare() mathods for all nodes (not tested)
  745. + nopt.pas, nadd.pas, i386/n386opt.pas: optimized nodes for adding strings
  746. and constant strings/chars together
  747. * n386add.pas: don't copy temp strings (of size 256) to another temp string
  748. when adding
  749. Revision 1.9 2000/11/29 00:30:33 florian
  750. * unused units removed from uses clause
  751. * some changes for widestrings
  752. Revision 1.8 2000/11/04 14:25:20 florian
  753. + merged Attila's changes for interfaces, not tested yet
  754. Revision 1.7 2000/10/31 22:02:49 peter
  755. * symtable splitted, no real code changes
  756. Revision 1.6 2000/10/14 10:14:50 peter
  757. * moehrendorf oct 2000 rewrite
  758. Revision 1.5 2000/10/01 19:48:24 peter
  759. * lot of compile updates for cg11
  760. Revision 1.4 2000/09/28 19:49:52 florian
  761. *** empty log message ***
  762. Revision 1.3 2000/09/27 18:14:31 florian
  763. * fixed a lot of syntax errors in the n*.pas stuff
  764. Revision 1.2 2000/09/25 15:37:14 florian
  765. * more fixes
  766. Revision 1.1 2000/09/25 14:55:05 florian
  767. * initial revision
  768. }