nld.pas 27 KB

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