nset.pas 26 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871
  1. {
  2. $Id$
  3. Copyright (c) 2000-2002 by Florian Klaempfl
  4. Type checking and register allocation for set/case 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 nset;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. node,globals,
  23. aasmbase,aasmtai,symtype;
  24. type
  25. pcaserecord = ^tcaserecord;
  26. tcaserecord = record
  27. { range }
  28. _low,_high : TConstExprInt;
  29. { only used by gentreejmp }
  30. _at : tasmlabel;
  31. { label of instruction }
  32. statement : tasmlabel;
  33. { is this the first of an case entry, needed to release statement
  34. label (PFV) }
  35. firstlabel : boolean;
  36. { left and right tree node }
  37. less,greater : pcaserecord;
  38. end;
  39. tsetelementnode = class(tbinarynode)
  40. constructor create(l,r : tnode);virtual;
  41. function det_resulttype:tnode;override;
  42. function pass_1 : tnode;override;
  43. end;
  44. tsetelementnodeclass = class of tsetelementnode;
  45. tinnode = class(tbinopnode)
  46. constructor create(l,r : tnode);virtual;
  47. function det_resulttype:tnode;override;
  48. function pass_1 : tnode;override;
  49. end;
  50. tinnodeclass = class of tinnode;
  51. trangenode = class(tbinarynode)
  52. constructor create(l,r : tnode);virtual;
  53. function det_resulttype:tnode;override;
  54. function pass_1 : tnode;override;
  55. end;
  56. trangenodeclass = class of trangenode;
  57. tcasenode = class(tbinarynode)
  58. nodes : pcaserecord;
  59. elseblock : tnode;
  60. constructor create(l,r : tnode;n : pcaserecord);virtual;
  61. destructor destroy;override;
  62. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  63. procedure ppuwrite(ppufile:tcompilerppufile);override;
  64. procedure buildderefimpl;override;
  65. procedure derefimpl;override;
  66. function getcopy : tnode;override;
  67. procedure insertintolist(l : tnodelist);override;
  68. function det_resulttype:tnode;override;
  69. function pass_1 : tnode;override;
  70. function docompare(p: tnode): boolean; override;
  71. end;
  72. tcasenodeclass = class of tcasenode;
  73. var
  74. csetelementnode : tsetelementnodeclass;
  75. cinnode : tinnodeclass;
  76. crangenode : trangenodeclass;
  77. ccasenode : tcasenodeclass;
  78. { counts the labels }
  79. function case_count_labels(root : pcaserecord) : longint;
  80. { searches the highest label }
  81. {$ifdef int64funcresok}
  82. function case_get_max(root : pcaserecord) : tconstexprint;
  83. {$else int64funcresok}
  84. function case_get_max(root : pcaserecord) : longint;
  85. {$endif int64funcresok}
  86. { searches the lowest label }
  87. {$ifdef int64funcresok}
  88. function case_get_min(root : pcaserecord) : tconstexprint;
  89. {$else int64funcresok}
  90. function case_get_min(root : pcaserecord) : longint;
  91. {$endif int64funcresok}
  92. function gencasenode(l,r : tnode;nodes : pcaserecord) : tnode;
  93. implementation
  94. uses
  95. globtype,systems,
  96. verbose,
  97. symconst,symdef,symsym,defutil,defcmp,
  98. htypechk,pass_1,
  99. nbas,ncnv,ncon,nld,cgobj,cgbase;
  100. function gencasenode(l,r : tnode;nodes : pcaserecord) : tnode;
  101. var
  102. t : tnode;
  103. begin
  104. t:=ccasenode.create(l,r,nodes);
  105. gencasenode:=t;
  106. end;
  107. {*****************************************************************************
  108. TSETELEMENTNODE
  109. *****************************************************************************}
  110. constructor tsetelementnode.create(l,r : tnode);
  111. begin
  112. inherited create(setelementn,l,r);
  113. end;
  114. function tsetelementnode.det_resulttype:tnode;
  115. begin
  116. result:=nil;
  117. resulttypepass(left);
  118. if assigned(right) then
  119. resulttypepass(right);
  120. set_varstate(left,vs_used,true);
  121. if codegenerror then
  122. exit;
  123. resulttype:=left.resulttype;
  124. end;
  125. function tsetelementnode.pass_1 : tnode;
  126. begin
  127. result:=nil;
  128. firstpass(left);
  129. if assigned(right) then
  130. firstpass(right);
  131. if codegenerror then
  132. exit;
  133. expectloc:=left.expectloc;
  134. calcregisters(self,0,0,0);
  135. end;
  136. {*****************************************************************************
  137. TINNODE
  138. *****************************************************************************}
  139. constructor tinnode.create(l,r : tnode);
  140. begin
  141. inherited create(inn,l,r);
  142. end;
  143. function tinnode.det_resulttype:tnode;
  144. var
  145. t : tnode;
  146. pst : pconstset;
  147. function createsetconst(psd : tsetdef) : pconstset;
  148. var
  149. pcs : pconstset;
  150. pes : tenumsym;
  151. i : longint;
  152. begin
  153. new(pcs);
  154. case psd.elementtype.def.deftype of
  155. enumdef :
  156. begin
  157. pes:=tenumsym(tenumdef(psd.elementtype.def).firstenum);
  158. while assigned(pes) do
  159. begin
  160. include(pcs^,pes.value);
  161. pes:=pes.nextenum;
  162. end;
  163. end;
  164. orddef :
  165. begin
  166. for i:=torddef(psd.elementtype.def).low to torddef(psd.elementtype.def).high do
  167. include(pcs^,i);
  168. end;
  169. end;
  170. createsetconst:=pcs;
  171. end;
  172. begin
  173. result:=nil;
  174. resulttype:=booltype;
  175. resulttypepass(right);
  176. set_varstate(right,vs_used,true);
  177. if codegenerror then
  178. exit;
  179. { Convert array constructor first to set }
  180. if is_array_constructor(right.resulttype.def) then
  181. begin
  182. arrayconstructor_to_set(right);
  183. firstpass(right);
  184. if codegenerror then
  185. exit;
  186. end;
  187. if right.resulttype.def.deftype<>setdef then
  188. CGMessage(sym_e_set_expected);
  189. if (right.nodetype=typen) then
  190. begin
  191. { we need to create a setconstn }
  192. pst:=createsetconst(tsetdef(ttypenode(right).resulttype.def));
  193. t:=csetconstnode.create(pst,ttypenode(right).resulttype);
  194. dispose(pst);
  195. right.free;
  196. right:=t;
  197. end;
  198. resulttypepass(left);
  199. set_varstate(left,vs_used,true);
  200. if codegenerror then
  201. exit;
  202. if not assigned(left.resulttype.def) then
  203. internalerror(20021126);
  204. { insert a hint that a range check error might occur on non-byte
  205. elements.with the in operator.
  206. }
  207. if (
  208. (left.resulttype.def.deftype = orddef) and not
  209. (torddef(left.resulttype.def).typ in [s8bit,u8bit,uchar,bool8bit])
  210. )
  211. or
  212. (
  213. (left.resulttype.def.deftype = enumdef) and
  214. (tenumdef(left.resulttype.def).maxval > 255)
  215. )
  216. then
  217. CGMessage(type_h_in_range_check);
  218. { type conversion/check }
  219. if assigned(tsetdef(right.resulttype.def).elementtype.def) then
  220. begin
  221. inserttypeconv(left,tsetdef(right.resulttype.def).elementtype);
  222. end;
  223. { empty set then return false }
  224. if not assigned(tsetdef(right.resulttype.def).elementtype.def) or
  225. ((right.nodetype = setconstn) and
  226. (tnormalset(tsetconstnode(right).value_set^) = [])) then
  227. begin
  228. t:=cordconstnode.create(0,booltype,false);
  229. resulttypepass(t);
  230. result:=t;
  231. exit;
  232. end;
  233. { constant evaluation }
  234. if (left.nodetype=ordconstn) and (right.nodetype=setconstn) then
  235. begin
  236. t:=cordconstnode.create(byte(tordconstnode(left).value in Tsetconstnode(right).value_set^),
  237. booltype,true);
  238. resulttypepass(t);
  239. result:=t;
  240. exit;
  241. end;
  242. end;
  243. { Warning : This is the first pass for the generic version }
  244. { the only difference is mainly the result location which }
  245. { is changed, compared to the i386 version. }
  246. { ALSO REGISTER ALLOC IS WRONG? }
  247. function tinnode.pass_1 : tnode;
  248. begin
  249. result:=nil;
  250. expectloc:=LOC_REGISTER;
  251. firstpass(right);
  252. firstpass(left);
  253. if codegenerror then
  254. exit;
  255. left_right_max;
  256. if tsetdef(right.resulttype.def).settype<>smallset then
  257. begin
  258. if registers32 < 3 then
  259. registers32 := 3;
  260. end
  261. else
  262. begin
  263. { a smallset needs maybe an misc. register }
  264. if (left.nodetype<>ordconstn) and
  265. not(right.expectloc in [LOC_CREGISTER,LOC_REGISTER]) and
  266. (right.registers32<1) then
  267. inc(registers32);
  268. end;
  269. end;
  270. {*****************************************************************************
  271. TRANGENODE
  272. *****************************************************************************}
  273. constructor trangenode.create(l,r : tnode);
  274. begin
  275. inherited create(rangen,l,r);
  276. end;
  277. function trangenode.det_resulttype : tnode;
  278. begin
  279. result:=nil;
  280. resulttypepass(left);
  281. resulttypepass(right);
  282. set_varstate(left,vs_used,true);
  283. set_varstate(right,vs_used,true);
  284. if codegenerror then
  285. exit;
  286. { both types must be compatible }
  287. if compare_defs(left.resulttype.def,right.resulttype.def,left.nodetype)=te_incompatible then
  288. CGMessage(type_e_mismatch);
  289. { Check if only when its a constant set }
  290. if (left.nodetype=ordconstn) and (right.nodetype=ordconstn) then
  291. begin
  292. { upper limit must be greater or equal than lower limit }
  293. if (tordconstnode(left).value>tordconstnode(right).value) and
  294. ((tordconstnode(left).value<0) or (tordconstnode(right).value>=0)) then
  295. CGMessage(cg_e_upper_lower_than_lower);
  296. end;
  297. resulttype:=left.resulttype;
  298. end;
  299. function trangenode.pass_1 : tnode;
  300. begin
  301. result:=nil;
  302. firstpass(left);
  303. firstpass(right);
  304. if codegenerror then
  305. exit;
  306. left_right_max;
  307. expectloc:=left.expectloc;
  308. end;
  309. {*****************************************************************************
  310. Case Helpers
  311. *****************************************************************************}
  312. function case_count_labels(root : pcaserecord) : longint;
  313. var
  314. _l : longint;
  315. procedure count(p : pcaserecord);
  316. begin
  317. inc(_l);
  318. if assigned(p^.less) then
  319. count(p^.less);
  320. if assigned(p^.greater) then
  321. count(p^.greater);
  322. end;
  323. begin
  324. _l:=0;
  325. count(root);
  326. case_count_labels:=_l;
  327. end;
  328. {$ifdef int64funcresok}
  329. function case_get_max(root : pcaserecord) : tconstexprint;
  330. {$else int64funcresok}
  331. function case_get_max(root : pcaserecord) : longint;
  332. {$endif int64funcresok}
  333. var
  334. hp : pcaserecord;
  335. begin
  336. hp:=root;
  337. while assigned(hp^.greater) do
  338. hp:=hp^.greater;
  339. case_get_max:=hp^._high;
  340. end;
  341. {$ifdef int64funcresok}
  342. function case_get_min(root : pcaserecord) : tconstexprint;
  343. {$else int64funcresok}
  344. function case_get_min(root : pcaserecord) : longint;
  345. {$endif int64funcresok}
  346. var
  347. hp : pcaserecord;
  348. begin
  349. hp:=root;
  350. while assigned(hp^.less) do
  351. hp:=hp^.less;
  352. case_get_min:=hp^._low;
  353. end;
  354. procedure deletecaselabels(p : pcaserecord);
  355. begin
  356. if assigned(p^.greater) then
  357. deletecaselabels(p^.greater);
  358. if assigned(p^.less) then
  359. deletecaselabels(p^.less);
  360. dispose(p);
  361. end;
  362. function copycaserecord(p : pcaserecord) : pcaserecord;
  363. var
  364. n : pcaserecord;
  365. begin
  366. new(n);
  367. n^:=p^;
  368. if assigned(p^.greater) then
  369. n^.greater:=copycaserecord(p^.greater);
  370. if assigned(p^.less) then
  371. n^.less:=copycaserecord(p^.less);
  372. copycaserecord:=n;
  373. end;
  374. procedure ppuwritecaserecord(ppufile:tcompilerppufile;p : pcaserecord);
  375. var
  376. b : byte;
  377. begin
  378. ppufile.putexprint(p^._low);
  379. ppufile.putexprint(p^._high);
  380. ppufile.putasmsymbol(p^._at);
  381. ppufile.putasmsymbol(p^.statement);
  382. ppufile.putbyte(byte(p^.firstlabel));
  383. b:=0;
  384. if assigned(p^.greater) then
  385. b:=b or 1;
  386. if assigned(p^.less) then
  387. b:=b or 2;
  388. ppufile.putbyte(b);
  389. if assigned(p^.greater) then
  390. ppuwritecaserecord(ppufile,p^.greater);
  391. if assigned(p^.less) then
  392. ppuwritecaserecord(ppufile,p^.less);
  393. end;
  394. function ppuloadcaserecord(ppufile:tcompilerppufile):pcaserecord;
  395. var
  396. b : byte;
  397. p : pcaserecord;
  398. begin
  399. new(p);
  400. p^._low:=ppufile.getexprint;
  401. p^._high:=ppufile.getexprint;
  402. p^._at:=tasmlabel(ppufile.getasmsymbol);
  403. p^.statement:=tasmlabel(ppufile.getasmsymbol);
  404. p^.firstlabel:=boolean(ppufile.getbyte);
  405. b:=ppufile.getbyte;
  406. if (b and 1)=1 then
  407. p^.greater:=ppuloadcaserecord(ppufile)
  408. else
  409. p^.greater:=nil;
  410. if (b and 2)=2 then
  411. p^.less:=ppuloadcaserecord(ppufile)
  412. else
  413. p^.less:=nil;
  414. ppuloadcaserecord:=p;
  415. end;
  416. procedure ppuderefcaserecord(p : pcaserecord);
  417. begin
  418. objectlibrary.derefasmsymbol(tasmsymbol(p^._at));
  419. objectlibrary.derefasmsymbol(tasmsymbol(p^.statement));
  420. if assigned(p^.greater) then
  421. ppuderefcaserecord(p^.greater);
  422. if assigned(p^.less) then
  423. ppuderefcaserecord(p^.less);
  424. end;
  425. {*****************************************************************************
  426. TCASENODE
  427. *****************************************************************************}
  428. constructor tcasenode.create(l,r : tnode;n : pcaserecord);
  429. begin
  430. inherited create(casen,l,r);
  431. nodes:=n;
  432. elseblock:=nil;
  433. set_file_line(l);
  434. end;
  435. destructor tcasenode.destroy;
  436. begin
  437. elseblock.free;
  438. deletecaselabels(nodes);
  439. inherited destroy;
  440. end;
  441. constructor tcasenode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  442. begin
  443. inherited ppuload(t,ppufile);
  444. elseblock:=ppuloadnode(ppufile);
  445. nodes:=ppuloadcaserecord(ppufile);
  446. end;
  447. procedure tcasenode.ppuwrite(ppufile:tcompilerppufile);
  448. begin
  449. inherited ppuwrite(ppufile);
  450. ppuwritenode(ppufile,elseblock);
  451. ppuwritecaserecord(ppufile,nodes);
  452. end;
  453. procedure tcasenode.buildderefimpl;
  454. begin
  455. inherited buildderefimpl;
  456. if assigned(elseblock) then
  457. elseblock.buildderefimpl;
  458. {ppubuildderefimplcaserecord(nodes);}
  459. end;
  460. procedure tcasenode.derefimpl;
  461. begin
  462. inherited derefimpl;
  463. if assigned(elseblock) then
  464. elseblock.derefimpl;
  465. ppuderefcaserecord(nodes);
  466. end;
  467. function tcasenode.det_resulttype : tnode;
  468. begin
  469. result:=nil;
  470. resulttype:=voidtype;
  471. end;
  472. function tcasenode.pass_1 : tnode;
  473. var
  474. old_t_times : longint;
  475. hp : tstatementnode;
  476. begin
  477. result:=nil;
  478. expectloc:=LOC_VOID;
  479. { evalutes the case expression }
  480. firstpass(left);
  481. set_varstate(left,vs_used,true);
  482. if codegenerror then
  483. exit;
  484. registers32:=left.registers32;
  485. registersfpu:=left.registersfpu;
  486. {$ifdef SUPPORT_MMX}
  487. registersmmx:=left.registersmmx;
  488. {$endif SUPPORT_MMX}
  489. { walk through all instructions }
  490. { estimates the repeat of each instruction }
  491. old_t_times:=cg.t_times;
  492. if not(cs_littlesize in aktglobalswitches) then
  493. begin
  494. cg.t_times:=cg.t_times div case_count_labels(nodes);
  495. if cg.t_times<1 then
  496. cg.t_times:=1;
  497. end;
  498. { first case }
  499. hp:=tstatementnode(right);
  500. while assigned(hp) do
  501. begin
  502. firstpass(hp.left);
  503. { searchs max registers }
  504. if hp.left.registers32>registers32 then
  505. registers32:=hp.left.registers32;
  506. if hp.left.registersfpu>registersfpu then
  507. registersfpu:=hp.left.registersfpu;
  508. {$ifdef SUPPORT_MMX}
  509. if hp.left.registersmmx>registersmmx then
  510. registersmmx:=hp.left.registersmmx;
  511. {$endif SUPPORT_MMX}
  512. hp:=tstatementnode(hp.right);
  513. end;
  514. { may be handle else tree }
  515. if assigned(elseblock) then
  516. begin
  517. firstpass(elseblock);
  518. if codegenerror then
  519. exit;
  520. if registers32<elseblock.registers32 then
  521. registers32:=elseblock.registers32;
  522. if registersfpu<elseblock.registersfpu then
  523. registersfpu:=elseblock.registersfpu;
  524. {$ifdef SUPPORT_MMX}
  525. if registersmmx<elseblock.registersmmx then
  526. registersmmx:=elseblock.registersmmx;
  527. {$endif SUPPORT_MMX}
  528. end;
  529. cg.t_times:=old_t_times;
  530. { there is one register required for the case expression }
  531. { for 64 bit ints we cheat: the high dword is stored in EDI }
  532. { so we don't need an extra register }
  533. if registers32<1 then registers32:=1;
  534. end;
  535. function tcasenode.getcopy : tnode;
  536. var
  537. p : tcasenode;
  538. begin
  539. p:=tcasenode(inherited getcopy);
  540. if assigned(elseblock) then
  541. p.elseblock:=elseblock.getcopy
  542. else
  543. p.elseblock:=nil;
  544. if assigned(nodes) then
  545. p.nodes:=copycaserecord(nodes)
  546. else
  547. p.nodes:=nil;
  548. getcopy:=p;
  549. end;
  550. procedure tcasenode.insertintolist(l : tnodelist);
  551. begin
  552. end;
  553. function casenodesequal(n1,n2: pcaserecord): boolean;
  554. begin
  555. casenodesequal :=
  556. (not assigned(n1) and not assigned(n2)) or
  557. (assigned(n1) and assigned(n2) and
  558. (n1^._low = n2^._low) and
  559. (n1^._high = n2^._high) and
  560. { the rest of the fields don't matter for equality (JM) }
  561. casenodesequal(n1^.less,n2^.less) and
  562. casenodesequal(n1^.greater,n2^.greater))
  563. end;
  564. function tcasenode.docompare(p: tnode): boolean;
  565. begin
  566. docompare :=
  567. inherited docompare(p) and
  568. casenodesequal(nodes,tcasenode(p).nodes) and
  569. elseblock.isequal(tcasenode(p).elseblock);
  570. end;
  571. begin
  572. csetelementnode:=tsetelementnode;
  573. cinnode:=tinnode;
  574. crangenode:=trangenode;
  575. ccasenode:=tcasenode;
  576. end.
  577. {
  578. $Log$
  579. Revision 1.51 2004-01-26 16:12:28 daniel
  580. * reginfo now also only allocated during register allocation
  581. * third round of gdb cleanups: kick out most of concatstabto
  582. Revision 1.50 2003/11/10 19:10:57 peter
  583. * check for enumdef.maxval<255 instead of enumdef.savesize
  584. Revision 1.49 2003/10/23 14:44:07 peter
  585. * splitted buildderef and buildderefimpl to fix interface crc
  586. calculation
  587. Revision 1.48 2003/10/22 20:40:00 peter
  588. * write derefdata in a separate ppu entry
  589. Revision 1.47 2003/10/09 21:31:37 daniel
  590. * Register allocator splitted, ans abstract now
  591. Revision 1.46 2003/10/08 19:19:45 peter
  592. * set_varstate cleanup
  593. Revision 1.45 2003/10/01 20:34:49 peter
  594. * procinfo unit contains tprocinfo
  595. * cginfo renamed to cgbase
  596. * moved cgmessage to verbose
  597. * fixed ppc and sparc compiles
  598. Revision 1.44 2003/09/03 15:55:01 peter
  599. * NEWRA branch merged
  600. Revision 1.43 2003/06/12 22:09:54 jonas
  601. * tcginnode.pass_2 doesn't call a helper anymore in any case
  602. * fixed ungetregisterfpu compilation problems
  603. Revision 1.42 2003/05/13 19:14:41 peter
  604. * failn removed
  605. * inherited result code check moven to pexpr
  606. Revision 1.41 2003/04/27 11:21:33 peter
  607. * aktprocdef renamed to current_procdef
  608. * procinfo renamed to current_procinfo
  609. * procinfo will now be stored in current_module so it can be
  610. cleaned up properly
  611. * gen_main_procsym changed to create_main_proc and release_main_proc
  612. to also generate a tprocinfo structure
  613. * fixed unit implicit initfinal
  614. Revision 1.40 2003/04/25 08:25:26 daniel
  615. * Ifdefs around a lot of calls to cleartempgen
  616. * Fixed registers that are allocated but not freed in several nodes
  617. * Tweak to register allocator to cause less spills
  618. * 8-bit registers now interfere with esi,edi and ebp
  619. Compiler can now compile rtl successfully when using new register
  620. allocator
  621. Revision 1.39 2003/04/22 23:50:23 peter
  622. * firstpass uses expectloc
  623. * checks if there are differences between the expectloc and
  624. location.loc from secondpass in EXTDEBUG
  625. Revision 1.38 2002/12/07 14:12:56 carl
  626. - removed unused variable
  627. Revision 1.37 2002/11/27 02:37:14 peter
  628. * case statement inlining added
  629. * fixed inlining of write()
  630. * switched statementnode left and right parts so the statements are
  631. processed in the correct order when getcopy is used. This is
  632. required for tempnodes
  633. Revision 1.36 2002/11/26 21:52:38 carl
  634. + hint for in operator with non byte sized operand
  635. Revision 1.35 2002/11/25 17:43:21 peter
  636. * splitted defbase in defutil,symutil,defcmp
  637. * merged isconvertable and is_equal into compare_defs(_ext)
  638. * made operator search faster by walking the list only once
  639. Revision 1.34 2002/10/05 12:43:25 carl
  640. * fixes for Delphi 6 compilation
  641. (warning : Some features do not work under Delphi)
  642. Revision 1.33 2002/09/07 12:16:03 carl
  643. * second part bug report 1996 fix, testrange in cordconstnode
  644. only called if option is set (also make parsing a tiny faster)
  645. Revision 1.32 2002/08/19 19:36:44 peter
  646. * More fixes for cross unit inlining, all tnodes are now implemented
  647. * Moved pocall_internconst to po_internconst because it is not a
  648. calling type at all and it conflicted when inlining of these small
  649. functions was requested
  650. Revision 1.31 2002/08/17 09:23:38 florian
  651. * first part of current_procinfo rewrite
  652. Revision 1.30 2002/07/23 13:19:40 jonas
  653. * fixed evaluation of expressions with empty sets that are calculated
  654. at compile time
  655. Revision 1.29 2002/07/23 12:34:30 daniel
  656. * Readded old set code. To use it define 'oldset'. Activated by default
  657. for ppc.
  658. Revision 1.28 2002/07/22 11:48:04 daniel
  659. * Sets are now internally sets.
  660. Revision 1.27 2002/07/20 11:57:55 florian
  661. * types.pas renamed to defbase.pas because D6 contains a types
  662. unit so this would conflicts if D6 programms are compiled
  663. + Willamette/SSE2 instructions to assembler added
  664. Revision 1.26 2002/07/06 20:19:25 carl
  665. + generic set handling
  666. Revision 1.25 2002/07/01 18:46:24 peter
  667. * internal linker
  668. * reorganized aasm layer
  669. Revision 1.24 2002/05/18 13:34:10 peter
  670. * readded missing revisions
  671. Revision 1.23 2002/05/16 19:46:39 carl
  672. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  673. + try to fix temp allocation (still in ifdef)
  674. + generic constructor calls
  675. + start of tassembler / tmodulebase class cleanup
  676. Revision 1.21 2002/05/12 16:53:08 peter
  677. * moved entry and exitcode to ncgutil and cgobj
  678. * foreach gets extra argument for passing local data to the
  679. iterator function
  680. * -CR checks also class typecasts at runtime by changing them
  681. into as
  682. * fixed compiler to cycle with the -CR option
  683. * fixed stabs with elf writer, finally the global variables can
  684. be watched
  685. * removed a lot of routines from cga unit and replaced them by
  686. calls to cgobj
  687. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  688. u32bit then the other is typecasted also to u32bit without giving
  689. a rangecheck warning/error.
  690. * fixed pascal calling method with reversing also the high tree in
  691. the parast, detected by tcalcst3 test
  692. Revision 1.20 2002/04/07 13:27:50 carl
  693. + change unit use
  694. Revision 1.19 2002/04/02 17:11:29 peter
  695. * tlocation,treference update
  696. * LOC_CONSTANT added for better constant handling
  697. * secondadd splitted in multiple routines
  698. * location_force_reg added for loading a location to a register
  699. of a specified size
  700. * secondassignment parses now first the right and then the left node
  701. (this is compatible with Kylix). This saves a lot of push/pop especially
  702. with string operations
  703. * adapted some routines to use the new cg methods
  704. Revision 1.18 2002/03/31 20:26:35 jonas
  705. + a_loadfpu_* and a_loadmm_* methods in tcg
  706. * register allocation is now handled by a class and is mostly processor
  707. independent (+rgobj.pas and i386/rgcpu.pas)
  708. * temp allocation is now handled by a class (+tgobj.pas, -i386\tgcpu.pas)
  709. * some small improvements and fixes to the optimizer
  710. * some register allocation fixes
  711. * some fpuvaroffset fixes in the unary minus node
  712. * push/popusedregisters is now called rg.save/restoreusedregisters and
  713. (for i386) uses temps instead of push/pop's when using -Op3 (that code is
  714. also better optimizable)
  715. * fixed and optimized register saving/restoring for new/dispose nodes
  716. * LOC_FPU locations now also require their "register" field to be set to
  717. R_ST, not R_ST0 (the latter is used for LOC_CFPUREGISTER locations only)
  718. - list field removed of the tnode class because it's not used currently
  719. and can cause hard-to-find bugs
  720. }