nld.pas 30 KB

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