nmem.pas 29 KB

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