nmem.pas 31 KB

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