nmem.pas 31 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042
  1. {
  2. $Id$
  3. Copyright (c) 2000 by Florian Klaempfl
  4. Type checking and register allocation for memory related 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 nmem;
  19. {$i defines.inc}
  20. interface
  21. uses
  22. node,
  23. symtype,symdef,symsym,symtable,
  24. cpubase;
  25. type
  26. tloadvmtnode = class(tunarynode)
  27. constructor create(l : tnode);virtual;
  28. function pass_1 : tnode;override;
  29. function det_resulttype:tnode;override;
  30. end;
  31. thnewnode = class(tnode)
  32. constructor create;virtual;
  33. function pass_1 : tnode;override;
  34. function det_resulttype:tnode;override;
  35. end;
  36. tnewnode = class(tunarynode)
  37. constructor create(l : tnode);virtual;
  38. function pass_1 : tnode;override;
  39. function det_resulttype:tnode;override;
  40. end;
  41. thdisposenode = class(tunarynode)
  42. constructor create(l : tnode);virtual;
  43. function pass_1 : tnode;override;
  44. function det_resulttype:tnode;override;
  45. end;
  46. tsimplenewdisposenode = class(tunarynode)
  47. constructor create(n : tnodetype;l : tnode);
  48. function pass_1 : tnode;override;
  49. function det_resulttype:tnode;override;
  50. end;
  51. taddrnode = class(tunarynode)
  52. constructor create(l : tnode);virtual;
  53. function pass_1 : tnode;override;
  54. function det_resulttype:tnode;override;
  55. end;
  56. tdoubleaddrnode = class(tunarynode)
  57. constructor create(l : tnode);virtual;
  58. function pass_1 : tnode;override;
  59. function det_resulttype:tnode;override;
  60. end;
  61. tderefnode = class(tunarynode)
  62. constructor create(l : tnode);virtual;
  63. function pass_1 : tnode;override;
  64. function det_resulttype:tnode;override;
  65. end;
  66. tsubscriptnode = class(tunarynode)
  67. vs : tvarsym;
  68. constructor create(varsym : tsym;l : tnode);virtual;
  69. function getcopy : tnode;override;
  70. function pass_1 : tnode;override;
  71. function docompare(p: tnode): boolean; override;
  72. function det_resulttype:tnode;override;
  73. end;
  74. tvecnode = class(tbinarynode)
  75. constructor create(l,r : tnode);virtual;
  76. function pass_1 : tnode;override;
  77. function det_resulttype:tnode;override;
  78. end;
  79. tselfnode = class(tnode)
  80. classdef : tobjectdef;
  81. constructor create(_class : tobjectdef);virtual;
  82. function pass_1 : tnode;override;
  83. function det_resulttype:tnode;override;
  84. end;
  85. twithnode = class(tbinarynode)
  86. withsymtable : twithsymtable;
  87. tablecount : longint;
  88. withreference : preference;
  89. constructor create(symtable : twithsymtable;l,r : tnode;count : longint);virtual;
  90. destructor destroy;override;
  91. function getcopy : tnode;override;
  92. function pass_1 : tnode;override;
  93. function docompare(p: tnode): boolean; override;
  94. function det_resulttype:tnode;override;
  95. end;
  96. var
  97. cloadvmtnode : class of tloadvmtnode;
  98. chnewnode : class of thnewnode;
  99. cnewnode : class of tnewnode;
  100. chdisposenode : class of thdisposenode;
  101. csimplenewdisposenode : class of tsimplenewdisposenode;
  102. caddrnode : class of taddrnode;
  103. cdoubleaddrnode : class of tdoubleaddrnode;
  104. cderefnode : class of tderefnode;
  105. csubscriptnode : class of tsubscriptnode;
  106. cvecnode : class of tvecnode;
  107. cselfnode : class of tselfnode;
  108. cwithnode : class of twithnode;
  109. implementation
  110. uses
  111. globtype,systems,
  112. cutils,verbose,globals,
  113. symconst,symbase,types,
  114. htypechk,pass_1,ncal,nld,ncon,ncnv,cgbase
  115. ;
  116. {*****************************************************************************
  117. TLOADVMTNODE
  118. *****************************************************************************}
  119. constructor tloadvmtnode.create(l : tnode);
  120. begin
  121. inherited create(loadvmtn,l);
  122. end;
  123. function tloadvmtnode.det_resulttype:tnode;
  124. begin
  125. result:=nil;
  126. resulttypepass(left);
  127. if codegenerror then
  128. exit;
  129. resulttype.setdef(tclassrefdef.create(left.resulttype));
  130. end;
  131. function tloadvmtnode.pass_1 : tnode;
  132. begin
  133. result:=nil;
  134. registers32:=1;
  135. location.loc:=LOC_REGISTER;
  136. end;
  137. {*****************************************************************************
  138. THNEWNODE
  139. *****************************************************************************}
  140. constructor thnewnode.create;
  141. begin
  142. inherited create(hnewn);
  143. end;
  144. function thnewnode.det_resulttype:tnode;
  145. begin
  146. result:=nil;
  147. resulttype:=voidtype;
  148. end;
  149. function thnewnode.pass_1 : tnode;
  150. begin
  151. result:=nil;
  152. end;
  153. {*****************************************************************************
  154. TNEWNODE
  155. *****************************************************************************}
  156. constructor tnewnode.create(l : tnode);
  157. begin
  158. inherited create(newn,l);
  159. end;
  160. function tnewnode.det_resulttype:tnode;
  161. begin
  162. result:=nil;
  163. if assigned(left) then
  164. resulttypepass(left);
  165. resulttype:=voidtype;
  166. end;
  167. function tnewnode.pass_1 : tnode;
  168. begin
  169. result:=nil;
  170. if assigned(left) then
  171. begin
  172. firstpass(left);
  173. if codegenerror then
  174. exit;
  175. registers32:=left.registers32;
  176. registersfpu:=left.registersfpu;
  177. {$ifdef SUPPORT_MMX}
  178. registersmmx:=left.registersmmx;
  179. {$endif SUPPORT_MMX}
  180. location.loc:=LOC_REGISTER
  181. end
  182. else
  183. location.loc:=LOC_REFERENCE;
  184. procinfo^.flags:=procinfo^.flags or pi_do_call;
  185. end;
  186. {*****************************************************************************
  187. THDISPOSENODE
  188. *****************************************************************************}
  189. constructor thdisposenode.create(l : tnode);
  190. begin
  191. inherited create(hdisposen,l);
  192. end;
  193. function thdisposenode.det_resulttype:tnode;
  194. begin
  195. result:=nil;
  196. resulttypepass(left);
  197. if codegenerror then
  198. exit;
  199. resulttype:=tpointerdef(left.resulttype.def).pointertype;
  200. end;
  201. function thdisposenode.pass_1 : tnode;
  202. begin
  203. result:=nil;
  204. firstpass(left);
  205. if codegenerror then
  206. exit;
  207. registers32:=left.registers32;
  208. registersfpu:=left.registersfpu;
  209. {$ifdef SUPPORT_MMX}
  210. registersmmx:=left.registersmmx;
  211. {$endif SUPPORT_MMX}
  212. if registers32<1 then
  213. registers32:=1;
  214. {
  215. if left.location.loc<>LOC_REFERENCE then
  216. CGMessage(cg_e_illegal_expression);
  217. }
  218. if left.location.loc=LOC_CREGISTER then
  219. inc(registers32);
  220. location.loc:=LOC_REFERENCE;
  221. end;
  222. {*****************************************************************************
  223. TSIMPLENEWDISPOSENODE
  224. *****************************************************************************}
  225. constructor tsimplenewdisposenode.create(n : tnodetype;l : tnode);
  226. begin
  227. inherited create(n,l);
  228. end;
  229. function tsimplenewdisposenode.det_resulttype:tnode;
  230. begin
  231. result:=nil;
  232. resulttypepass(left);
  233. if codegenerror then
  234. exit;
  235. if (left.resulttype.def.deftype<>pointerdef) then
  236. CGMessage1(type_e_pointer_type_expected,left.resulttype.def.typename);
  237. resulttype:=voidtype;
  238. end;
  239. function tsimplenewdisposenode.pass_1 : tnode;
  240. begin
  241. result:=nil;
  242. { this cannot be in a register !! }
  243. make_not_regable(left);
  244. firstpass(left);
  245. if codegenerror then
  246. exit;
  247. if (left.location.loc<>LOC_REFERENCE) {and
  248. (left.location.loc<>LOC_CREGISTER)} then
  249. CGMessage(cg_e_illegal_expression);
  250. registers32:=left.registers32;
  251. registersfpu:=left.registersfpu;
  252. {$ifdef SUPPORT_MMX}
  253. registersmmx:=left.registersmmx;
  254. {$endif SUPPORT_MMX}
  255. procinfo^.flags:=procinfo^.flags or pi_do_call;
  256. end;
  257. {*****************************************************************************
  258. TADDRNODE
  259. *****************************************************************************}
  260. constructor taddrnode.create(l : tnode);
  261. begin
  262. inherited create(addrn,l);
  263. end;
  264. function taddrnode.det_resulttype:tnode;
  265. var
  266. hp : tnode;
  267. hp2 : TParaItem;
  268. hp3 : tabstractprocdef;
  269. begin
  270. result:=nil;
  271. resulttypepass(left);
  272. if codegenerror then
  273. exit;
  274. { don't allow constants }
  275. if is_constnode(left) then
  276. begin
  277. aktfilepos:=left.fileinfo;
  278. CGMessage(type_e_no_addr_of_constant);
  279. exit;
  280. end;
  281. { tp @procvar support (type of @procvar is a void pointer)
  282. Note: we need to leave the addrn in the tree,
  283. else we can't see the difference between @procvar and procvar.
  284. we set the procvarload flag so a secondpass does nothing for
  285. this node (PFV) }
  286. if (m_tp_procvar in aktmodeswitches) then
  287. begin
  288. case left.nodetype of
  289. calln :
  290. begin
  291. { is it a procvar? }
  292. hp:=tcallnode(left).right;
  293. if assigned(hp) then
  294. begin
  295. { remove calln node }
  296. tcallnode(left).right:=nil;
  297. left.free;
  298. left:=hp;
  299. include(flags,nf_procvarload);
  300. end;
  301. end;
  302. loadn,
  303. subscriptn,
  304. typeconvn,
  305. vecn,
  306. derefn :
  307. begin
  308. if left.resulttype.def.deftype=procvardef then
  309. include(flags,nf_procvarload);
  310. end;
  311. end;
  312. if nf_procvarload in flags then
  313. begin
  314. resulttype:=voidpointertype;
  315. exit;
  316. end;
  317. end;
  318. { proc 2 procvar ? }
  319. if left.nodetype=calln then
  320. internalerror(200103253)
  321. else
  322. if (left.nodetype=loadn) and (tloadnode(left).symtableentry.typ=procsym) then
  323. begin
  324. { the address is already available when loading a procedure of object }
  325. if assigned(tloadnode(left).left) then
  326. include(flags,nf_procvarload);
  327. { result is a procedure variable }
  328. { No, to be TP compatible, you must return a voidpointer to
  329. the procedure that is stored in the procvar.}
  330. if not(m_tp_procvar in aktmodeswitches) then
  331. begin
  332. hp3:=tabstractprocdef(tprocsym(tloadnode(left).symtableentry).definition);
  333. { create procvardef }
  334. resulttype.setdef(tprocvardef.create);
  335. tprocvardef(resulttype.def).proctypeoption:=hp3.proctypeoption;
  336. tprocvardef(resulttype.def).proccalloptions:=hp3.proccalloptions;
  337. tprocvardef(resulttype.def).procoptions:=hp3.procoptions;
  338. tprocvardef(resulttype.def).rettype:=hp3.rettype;
  339. tprocvardef(resulttype.def).symtablelevel:=hp3.symtablelevel;
  340. { method ? then set the methodpointer flag }
  341. if (hp3.owner.symtabletype=objectsymtable) then
  342. include(tprocvardef(resulttype.def).procoptions,po_methodpointer);
  343. { we need to process the parameters reverse so they are inserted
  344. in the correct right2left order (PFV) }
  345. hp2:=TParaItem(hp3.Para.last);
  346. while assigned(hp2) do
  347. begin
  348. tprocvardef(resulttype.def).concatpara(hp2.paratype,hp2.paratyp,hp2.defaultvalue);
  349. hp2:=TParaItem(hp2.previous);
  350. end;
  351. end
  352. else
  353. resulttype:=voidpointertype;
  354. end
  355. else
  356. begin
  357. { what are we getting the address from an absolute sym? }
  358. hp:=left;
  359. while assigned(hp) and (hp.nodetype in [vecn,derefn,subscriptn]) do
  360. hp:=tunarynode(hp).left;
  361. if assigned(hp) and (hp.nodetype=loadn) and
  362. ((tloadnode(hp).symtableentry.typ=absolutesym) and
  363. tabsolutesym(tloadnode(hp).symtableentry).absseg) then
  364. begin
  365. if not(cs_typed_addresses in aktlocalswitches) then
  366. resulttype:=voidfarpointertype
  367. else
  368. resulttype.setdef(tpointerdef.createfar(left.resulttype));
  369. end
  370. else
  371. begin
  372. if not(cs_typed_addresses in aktlocalswitches) then
  373. resulttype:=voidpointertype
  374. else
  375. resulttype.setdef(tpointerdef.create(left.resulttype));
  376. end;
  377. end;
  378. { this is like the function addr }
  379. inc(parsing_para_level);
  380. set_varstate(left,false);
  381. dec(parsing_para_level);
  382. end;
  383. function taddrnode.pass_1 : tnode;
  384. begin
  385. result:=nil;
  386. firstpass(left);
  387. if codegenerror then
  388. exit;
  389. make_not_regable(left);
  390. if nf_procvarload in flags then
  391. begin
  392. registers32:=left.registers32;
  393. registersfpu:=left.registersfpu;
  394. {$ifdef SUPPORT_MMX}
  395. registersmmx:=left.registersmmx;
  396. {$endif SUPPORT_MMX}
  397. if registers32<1 then
  398. registers32:=1;
  399. location.loc:=left.location.loc;
  400. exit;
  401. end;
  402. { we should allow loc_mem for @string }
  403. if not(left.location.loc in [LOC_MEM,LOC_REFERENCE]) then
  404. begin
  405. aktfilepos:=left.fileinfo;
  406. CGMessage(cg_e_illegal_expression);
  407. end;
  408. registers32:=left.registers32;
  409. registersfpu:=left.registersfpu;
  410. {$ifdef SUPPORT_MMX}
  411. registersmmx:=left.registersmmx;
  412. {$endif SUPPORT_MMX}
  413. if registers32<1 then
  414. registers32:=1;
  415. { is this right for object of methods ?? }
  416. location.loc:=LOC_REGISTER;
  417. end;
  418. {*****************************************************************************
  419. TDOUBLEADDRNODE
  420. *****************************************************************************}
  421. constructor tdoubleaddrnode.create(l : tnode);
  422. begin
  423. inherited create(doubleaddrn,l);
  424. end;
  425. function tdoubleaddrnode.det_resulttype:tnode;
  426. begin
  427. result:=nil;
  428. resulttypepass(left);
  429. if codegenerror then
  430. exit;
  431. inc(parsing_para_level);
  432. set_varstate(left,false);
  433. dec(parsing_para_level);
  434. if (left.resulttype.def.deftype)<>procvardef then
  435. CGMessage(cg_e_illegal_expression);
  436. resulttype:=voidpointertype;
  437. end;
  438. function tdoubleaddrnode.pass_1 : tnode;
  439. begin
  440. result:=nil;
  441. make_not_regable(left);
  442. firstpass(left);
  443. if codegenerror then
  444. exit;
  445. if (left.location.loc<>LOC_REFERENCE) then
  446. CGMessage(cg_e_illegal_expression);
  447. registers32:=left.registers32;
  448. registersfpu:=left.registersfpu;
  449. {$ifdef SUPPORT_MMX}
  450. registersmmx:=left.registersmmx;
  451. {$endif SUPPORT_MMX}
  452. if registers32<1 then
  453. registers32:=1;
  454. location.loc:=LOC_REGISTER;
  455. end;
  456. {*****************************************************************************
  457. TDEREFNODE
  458. *****************************************************************************}
  459. constructor tderefnode.create(l : tnode);
  460. begin
  461. inherited create(derefn,l);
  462. end;
  463. function tderefnode.det_resulttype:tnode;
  464. begin
  465. result:=nil;
  466. resulttypepass(left);
  467. set_varstate(left,true);
  468. if codegenerror then
  469. exit;
  470. if left.resulttype.def.deftype=pointerdef then
  471. resulttype:=tpointerdef(left.resulttype.def).pointertype
  472. else
  473. CGMessage(cg_e_invalid_qualifier);
  474. end;
  475. function tderefnode.pass_1 : tnode;
  476. begin
  477. result:=nil;
  478. firstpass(left);
  479. if codegenerror then
  480. exit;
  481. registers32:=max(left.registers32,1);
  482. registersfpu:=left.registersfpu;
  483. {$ifdef SUPPORT_MMX}
  484. registersmmx:=left.registersmmx;
  485. {$endif SUPPORT_MMX}
  486. location.loc:=LOC_REFERENCE;
  487. end;
  488. {*****************************************************************************
  489. TSUBSCRIPTNODE
  490. *****************************************************************************}
  491. constructor tsubscriptnode.create(varsym : tsym;l : tnode);
  492. begin
  493. inherited create(subscriptn,l);
  494. { vs should be changed to tsym! }
  495. vs:=tvarsym(varsym);
  496. end;
  497. function tsubscriptnode.getcopy : tnode;
  498. var
  499. p : tsubscriptnode;
  500. begin
  501. p:=tsubscriptnode(inherited getcopy);
  502. p.vs:=vs;
  503. getcopy:=p;
  504. end;
  505. function tsubscriptnode.det_resulttype:tnode;
  506. begin
  507. result:=nil;
  508. resulttypepass(left);
  509. resulttype:=vs.vartype;
  510. end;
  511. function tsubscriptnode.pass_1 : tnode;
  512. begin
  513. result:=nil;
  514. firstpass(left);
  515. if codegenerror then
  516. exit;
  517. registers32:=left.registers32;
  518. registersfpu:=left.registersfpu;
  519. {$ifdef SUPPORT_MMX}
  520. registersmmx:=left.registersmmx;
  521. {$endif SUPPORT_MMX}
  522. { classes must be dereferenced implicit }
  523. if is_class_or_interface(left.resulttype.def) then
  524. begin
  525. if registers32=0 then
  526. registers32:=1;
  527. location.loc:=LOC_REFERENCE;
  528. end
  529. else
  530. begin
  531. if (left.location.loc<>LOC_MEM) and
  532. (left.location.loc<>LOC_REFERENCE) then
  533. CGMessage(cg_e_illegal_expression);
  534. set_location(location,left.location);
  535. end;
  536. end;
  537. function tsubscriptnode.docompare(p: tnode): boolean;
  538. begin
  539. docompare :=
  540. inherited docompare(p) and
  541. (vs = tsubscriptnode(p).vs);
  542. end;
  543. {*****************************************************************************
  544. TVECNODE
  545. *****************************************************************************}
  546. constructor tvecnode.create(l,r : tnode);
  547. begin
  548. inherited create(vecn,l,r);
  549. end;
  550. function tvecnode.det_resulttype:tnode;
  551. var
  552. htype : ttype;
  553. ct : tconverttype;
  554. begin
  555. result:=nil;
  556. resulttypepass(left);
  557. resulttypepass(right);
  558. if codegenerror then
  559. exit;
  560. { range check only for arrays }
  561. if (left.resulttype.def.deftype=arraydef) then
  562. begin
  563. if (isconvertable(right.resulttype.def,tarraydef(left.resulttype.def).rangetype.def,
  564. ct,ordconstn,false)=0) and
  565. not(is_equal(right.resulttype.def,tarraydef(left.resulttype.def).rangetype.def)) then
  566. CGMessage(type_e_mismatch);
  567. end;
  568. { Never convert a boolean or a char !}
  569. { maybe type conversion }
  570. if (right.resulttype.def.deftype<>enumdef) and
  571. not(is_char(right.resulttype.def)) and
  572. not(is_boolean(right.resulttype.def)) then
  573. begin
  574. inserttypeconv(right,s32bittype);
  575. end;
  576. { are we accessing a pointer[], then convert the pointer to
  577. an array first, in FPC this is allowed for all pointers in
  578. delphi/tp7 it's only allowed for pchars }
  579. if (left.resulttype.def.deftype=pointerdef) and
  580. ((m_fpc in aktmodeswitches) or
  581. is_pchar(left.resulttype.def) or
  582. is_pwidechar(left.resulttype.def)) then
  583. begin
  584. { convert pointer to array }
  585. htype.setdef(tarraydef.create(0,$7fffffff,s32bittype));
  586. tarraydef(htype.def).elementtype:=tpointerdef(left.resulttype.def).pointertype;
  587. inserttypeconv(left,htype);
  588. resulttype:=tarraydef(htype.def).elementtype;
  589. end;
  590. { determine return type }
  591. if not assigned(resulttype.def) then
  592. if left.resulttype.def.deftype=arraydef then
  593. resulttype:=tarraydef(left.resulttype.def).elementtype
  594. else if left.resulttype.def.deftype=stringdef then
  595. begin
  596. { indexed access to strings }
  597. case tstringdef(left.resulttype.def).string_typ of
  598. st_widestring :
  599. resulttype:=cwidechartype;
  600. st_ansistring :
  601. resulttype:=cchartype;
  602. st_longstring :
  603. resulttype:=cchartype;
  604. st_shortstring :
  605. resulttype:=cchartype;
  606. end;
  607. end
  608. else
  609. CGMessage(type_e_array_required);
  610. end;
  611. function tvecnode.pass_1 : tnode;
  612. {$ifdef consteval}
  613. var
  614. tcsym : ttypedconstsym;
  615. {$endif}
  616. begin
  617. result:=nil;
  618. firstpass(left);
  619. firstpass(right);
  620. if codegenerror then
  621. exit;
  622. { the register calculation is easy if a const index is used }
  623. if right.nodetype=ordconstn then
  624. begin
  625. {$ifdef consteval}
  626. { constant evaluation }
  627. if (left.nodetype=loadn) and
  628. (left.symtableentry.typ=typedconstsym) then
  629. begin
  630. tcsym:=ttypedconstsym(left.symtableentry);
  631. if tcsym.defintion^.typ=stringdef then
  632. begin
  633. end;
  634. end;
  635. {$endif}
  636. registers32:=left.registers32;
  637. { for ansi/wide strings, we need at least one register }
  638. if is_ansistring(left.resulttype.def) or
  639. is_widestring(left.resulttype.def) or
  640. { ... as well as for dynamic arrays }
  641. is_dynamic_array(left.resulttype.def) then
  642. registers32:=max(registers32,1);
  643. end
  644. else
  645. begin
  646. { this rules are suboptimal, but they should give }
  647. { good results }
  648. registers32:=max(left.registers32,right.registers32);
  649. { for ansi/wide strings, we need at least one register }
  650. if is_ansistring(left.resulttype.def) or
  651. is_widestring(left.resulttype.def) or
  652. { ... as well as for dynamic arrays }
  653. is_dynamic_array(left.resulttype.def) then
  654. registers32:=max(registers32,1);
  655. { need we an extra register when doing the restore ? }
  656. if (left.registers32<=right.registers32) and
  657. { only if the node needs less than 3 registers }
  658. { two for the right node and one for the }
  659. { left address }
  660. (registers32<3) then
  661. inc(registers32);
  662. { need we an extra register for the index ? }
  663. if (right.location.loc<>LOC_REGISTER)
  664. { only if the right node doesn't need a register }
  665. and (right.registers32<1) then
  666. inc(registers32);
  667. { not correct, but what works better ?
  668. if left.registers32>0 then
  669. registers32:=max(registers32,2)
  670. else
  671. min. one register
  672. registers32:=max(registers32,1);
  673. }
  674. end;
  675. registersfpu:=max(left.registersfpu,right.registersfpu);
  676. {$ifdef SUPPORT_MMX}
  677. registersmmx:=max(left.registersmmx,right.registersmmx);
  678. {$endif SUPPORT_MMX}
  679. if left.location.loc in [LOC_CREGISTER,LOC_REFERENCE] then
  680. location.loc:=LOC_REFERENCE
  681. else
  682. location.loc:=LOC_MEM;
  683. end;
  684. {*****************************************************************************
  685. TSELFNODE
  686. *****************************************************************************}
  687. constructor tselfnode.create(_class : tobjectdef);
  688. begin
  689. inherited create(selfn);
  690. classdef:=_class;
  691. end;
  692. function tselfnode.det_resulttype:tnode;
  693. begin
  694. result:=nil;
  695. resulttype.setdef(classdef);
  696. end;
  697. function tselfnode.pass_1 : tnode;
  698. begin
  699. result:=nil;
  700. if (resulttype.def.deftype=classrefdef) or
  701. is_class(resulttype.def) then
  702. location.loc:=LOC_CREGISTER
  703. else
  704. location.loc:=LOC_REFERENCE;
  705. end;
  706. {*****************************************************************************
  707. TWITHNODE
  708. *****************************************************************************}
  709. constructor twithnode.create(symtable : twithsymtable;l,r : tnode;count : longint);
  710. begin
  711. inherited create(withn,l,r);
  712. withsymtable:=symtable;
  713. tablecount:=count;
  714. withreference:=nil;
  715. set_file_line(l);
  716. end;
  717. destructor twithnode.destroy;
  718. var
  719. symt : tsymtable;
  720. i : longint;
  721. begin
  722. symt:=withsymtable;
  723. for i:=1 to tablecount do
  724. begin
  725. if assigned(symt) then
  726. begin
  727. withsymtable:=twithsymtable(symt.next);
  728. symt.free;
  729. end;
  730. symt:=withsymtable;
  731. end;
  732. inherited destroy;
  733. end;
  734. function twithnode.getcopy : tnode;
  735. var
  736. p : twithnode;
  737. begin
  738. p:=twithnode(inherited getcopy);
  739. p.withsymtable:=withsymtable;
  740. p.tablecount:=tablecount;
  741. p.withreference:=withreference;
  742. result:=p;
  743. end;
  744. function twithnode.det_resulttype:tnode;
  745. var
  746. symtable : twithsymtable;
  747. i : longint;
  748. begin
  749. result:=nil;
  750. resulttype:=voidtype;
  751. if assigned(left) and assigned(right) then
  752. begin
  753. resulttypepass(left);
  754. unset_varstate(left);
  755. set_varstate(left,true);
  756. if codegenerror then
  757. exit;
  758. symtable:=withsymtable;
  759. for i:=1 to tablecount do
  760. begin
  761. if (left.nodetype=loadn) and
  762. (tloadnode(left).symtable=aktprocsym.definition.localst) then
  763. symtable.direct_with:=true;
  764. symtable.withnode:=self;
  765. symtable:=twithsymtable(symtable.next);
  766. end;
  767. resulttypepass(right);
  768. if codegenerror then
  769. exit;
  770. end;
  771. resulttype:=voidtype;
  772. end;
  773. function twithnode.pass_1 : tnode;
  774. begin
  775. result:=nil;
  776. if assigned(left) and assigned(right) then
  777. begin
  778. firstpass(left);
  779. firstpass(right);
  780. if codegenerror then
  781. exit;
  782. left_right_max;
  783. end
  784. else
  785. begin
  786. { optimization }
  787. result:=nil;
  788. end;
  789. end;
  790. function twithnode.docompare(p: tnode): boolean;
  791. begin
  792. docompare :=
  793. inherited docompare(p) and
  794. (withsymtable = twithnode(p).withsymtable) and
  795. (tablecount = twithnode(p).tablecount);
  796. end;
  797. begin
  798. cloadvmtnode := tloadvmtnode;
  799. chnewnode := thnewnode;
  800. cnewnode := tnewnode;
  801. chdisposenode := thdisposenode;
  802. csimplenewdisposenode := tsimplenewdisposenode;
  803. caddrnode := taddrnode;
  804. cdoubleaddrnode := tdoubleaddrnode;
  805. cderefnode := tderefnode;
  806. csubscriptnode := tsubscriptnode;
  807. cvecnode := tvecnode;
  808. cselfnode := tselfnode;
  809. cwithnode := twithnode;
  810. end.
  811. {
  812. $Log$
  813. Revision 1.19 2001-08-26 13:36:42 florian
  814. * some cg reorganisation
  815. * some PPC updates
  816. Revision 1.18 2001/04/13 22:15:21 peter
  817. * removed wrongly placed set_varstate in subscriptnode
  818. Revision 1.17 2001/04/13 01:22:10 peter
  819. * symtable change to classes
  820. * range check generation and errors fixed, make cycle DEBUG=1 works
  821. * memory leaks fixed
  822. Revision 1.16 2001/04/02 21:20:31 peter
  823. * resulttype rewrite
  824. Revision 1.15 2001/03/23 00:16:07 florian
  825. + some stuff to compile FreeCLX added
  826. Revision 1.14 2000/12/31 11:14:11 jonas
  827. + implemented/fixed docompare() mathods for all nodes (not tested)
  828. + nopt.pas, nadd.pas, i386/n386opt.pas: optimized nodes for adding strings
  829. and constant strings/chars together
  830. * n386add.pas: don't copy temp strings (of size 256) to another temp string
  831. when adding
  832. Revision 1.13 2000/12/25 00:07:26 peter
  833. + new tlinkedlist class (merge of old tstringqueue,tcontainer and
  834. tlinkedlist objects)
  835. Revision 1.12 2000/12/05 15:19:50 jonas
  836. * fixed webbug 1268 ("merged")
  837. Revision 1.11 2000/11/29 00:30:34 florian
  838. * unused units removed from uses clause
  839. * some changes for widestrings
  840. Revision 1.10 2000/11/04 14:25:20 florian
  841. + merged Attila's changes for interfaces, not tested yet
  842. Revision 1.9 2000/10/31 22:02:49 peter
  843. * symtable splitted, no real code changes
  844. Revision 1.8 2000/10/21 18:16:11 florian
  845. * a lot of changes:
  846. - basic dyn. array support
  847. - basic C++ support
  848. - some work for interfaces done
  849. ....
  850. Revision 1.7 2000/10/14 21:52:55 peter
  851. * fixed memory leaks
  852. Revision 1.6 2000/10/14 10:14:51 peter
  853. * moehrendorf oct 2000 rewrite
  854. Revision 1.5 2000/10/01 19:48:24 peter
  855. * lot of compile updates for cg11
  856. Revision 1.4 2000/09/28 19:49:52 florian
  857. *** empty log message ***
  858. Revision 1.3 2000/09/25 15:37:14 florian
  859. * more fixes
  860. Revision 1.2 2000/09/25 15:05:25 florian
  861. * some updates
  862. Revision 1.1 2000/09/25 09:58:22 florian
  863. * first revision for testing purpose
  864. }