ncon.pas 28 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993
  1. {
  2. $Id$
  3. Copyright (c) 2000-2002 by Florian Klaempfl
  4. Type checking and register allocation for constants
  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 ncon;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. globtype,widestr,
  23. node,
  24. aasmbase,aasmtai,cpuinfo,globals,
  25. symconst,symppu,symtype,symdef,symsym;
  26. type
  27. trealconstnode = class(tnode)
  28. restype : ttype;
  29. value_real : bestreal;
  30. lab_real : tasmlabel;
  31. constructor create(v : bestreal;const t:ttype);virtual;
  32. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  33. procedure ppuwrite(ppufile:tcompilerppufile);override;
  34. procedure derefimpl;override;
  35. function getcopy : tnode;override;
  36. function pass_1 : tnode;override;
  37. function det_resulttype:tnode;override;
  38. function docompare(p: tnode) : boolean; override;
  39. end;
  40. trealconstnodeclass = class of trealconstnode;
  41. tordconstnode = class(tnode)
  42. restype : ttype;
  43. value : TConstExprInt;
  44. constructor create(v : tconstexprint;const t:ttype);virtual;
  45. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  46. procedure ppuwrite(ppufile:tcompilerppufile);override;
  47. procedure derefimpl;override;
  48. function getcopy : tnode;override;
  49. function pass_1 : tnode;override;
  50. function det_resulttype:tnode;override;
  51. function docompare(p: tnode) : boolean; override;
  52. {$ifdef extdebug}
  53. procedure _dowrite;override;
  54. {$endif}
  55. end;
  56. tordconstnodeclass = class of tordconstnode;
  57. tpointerconstnode = class(tnode)
  58. restype : ttype;
  59. value : TConstPtrUInt;
  60. constructor create(v : TConstPtrUInt;const t:ttype);virtual;
  61. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  62. procedure ppuwrite(ppufile:tcompilerppufile);override;
  63. procedure derefimpl;override;
  64. function getcopy : tnode;override;
  65. function pass_1 : tnode;override;
  66. function det_resulttype:tnode;override;
  67. function docompare(p: tnode) : boolean; override;
  68. end;
  69. tpointerconstnodeclass = class of tpointerconstnode;
  70. tstringconstnode = class(tnode)
  71. value_str : pchar;
  72. len : longint;
  73. lab_str : tasmlabel;
  74. st_type : tstringtype;
  75. constructor createstr(const s : string;st:tstringtype);virtual;
  76. constructor createpchar(s : pchar;l : longint);virtual;
  77. constructor createwstr(w : pcompilerwidestring);virtual;
  78. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  79. procedure ppuwrite(ppufile:tcompilerppufile);override;
  80. procedure derefimpl;override;
  81. destructor destroy;override;
  82. function getcopy : tnode;override;
  83. function pass_1 : tnode;override;
  84. function det_resulttype:tnode;override;
  85. function getpcharcopy : pchar;
  86. function docompare(p: tnode) : boolean; override;
  87. end;
  88. tstringconstnodeclass = class of tstringconstnode;
  89. tsetconstnode = class(tunarynode)
  90. restype : ttype;
  91. value_set : pconstset;
  92. lab_set : tasmlabel;
  93. constructor create(s : pconstset;const t:ttype);virtual;
  94. destructor destroy;override;
  95. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  96. procedure ppuwrite(ppufile:tcompilerppufile);override;
  97. procedure derefimpl;override;
  98. function getcopy : tnode;override;
  99. function pass_1 : tnode;override;
  100. function det_resulttype:tnode;override;
  101. function docompare(p: tnode) : boolean; override;
  102. end;
  103. tsetconstnodeclass = class of tsetconstnode;
  104. tnilnode = class(tnode)
  105. constructor create;virtual;
  106. function pass_1 : tnode;override;
  107. function det_resulttype:tnode;override;
  108. end;
  109. tnilnodeclass = class of tnilnode;
  110. tguidconstnode = class(tnode)
  111. value : tguid;
  112. constructor create(const g:tguid);virtual;
  113. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  114. procedure ppuwrite(ppufile:tcompilerppufile);override;
  115. function getcopy : tnode;override;
  116. function pass_1 : tnode;override;
  117. function det_resulttype:tnode;override;
  118. function docompare(p: tnode) : boolean; override;
  119. end;
  120. tguidconstnodeclass = class of tguidconstnode;
  121. var
  122. crealconstnode : trealconstnodeclass;
  123. cordconstnode : tordconstnodeclass;
  124. cpointerconstnode : tpointerconstnodeclass;
  125. cstringconstnode : tstringconstnodeclass;
  126. csetconstnode : tsetconstnodeclass;
  127. cguidconstnode : tguidconstnodeclass;
  128. cnilnode : tnilnodeclass;
  129. function genintconstnode(v : TConstExprInt) : tordconstnode;
  130. function genenumnode(v : tenumsym) : tordconstnode;
  131. { some helper routines }
  132. {$ifdef INT64FUNCRESOK}
  133. function get_ordinal_value(p : tnode) : TConstExprInt;
  134. {$else INT64FUNCRESOK}
  135. function get_ordinal_value(p : tnode) : longint;
  136. {$endif INT64FUNCRESOK}
  137. function is_constnode(p : tnode) : boolean;
  138. function is_constintnode(p : tnode) : boolean;
  139. function is_constcharnode(p : tnode) : boolean;
  140. function is_constrealnode(p : tnode) : boolean;
  141. function is_constboolnode(p : tnode) : boolean;
  142. function is_constresourcestringnode(p : tnode) : boolean;
  143. function is_constwidecharnode(p : tnode) : boolean;
  144. function str_length(p : tnode) : longint;
  145. function is_emptyset(p : tnode):boolean;
  146. function genconstsymtree(p : tconstsym) : tnode;
  147. implementation
  148. uses
  149. cutils,verbose,systems,
  150. defbase,cpubase,nld;
  151. function genintconstnode(v : TConstExprInt) : tordconstnode;
  152. var
  153. i,i2 : TConstExprInt;
  154. begin
  155. { we need to bootstrap this code, so it's a little bit messy }
  156. i:=2147483647;
  157. { maxcardinal }
  158. i2 := i+i+1;
  159. if (v<=i) and (v>=-i-1) then
  160. genintconstnode:=cordconstnode.create(v,s32bittype)
  161. else if (v > i) and (v <= i2) then
  162. genintconstnode:=cordconstnode.create(v,u32bittype)
  163. else
  164. genintconstnode:=cordconstnode.create(v,cs64bittype);
  165. end;
  166. function genenumnode(v : tenumsym) : tordconstnode;
  167. var
  168. htype : ttype;
  169. begin
  170. htype.setdef(v.definition);
  171. genenumnode:=cordconstnode.create(v.value,htype);
  172. end;
  173. {$ifdef INT64FUNCRESOK}
  174. function get_ordinal_value(p : tnode) : TConstExprInt;
  175. {$else INT64FUNCRESOK}
  176. function get_ordinal_value(p : tnode) : longint;
  177. {$endif INT64FUNCRESOK}
  178. begin
  179. if p.nodetype=ordconstn then
  180. get_ordinal_value:=tordconstnode(p).value
  181. else
  182. begin
  183. Message(type_e_ordinal_expr_expected);
  184. get_ordinal_value:=0;
  185. end;
  186. end;
  187. function is_constnode(p : tnode) : boolean;
  188. begin
  189. is_constnode:=(p.nodetype in [ordconstn,realconstn,stringconstn,setconstn,guidconstn]);
  190. end;
  191. function is_constintnode(p : tnode) : boolean;
  192. begin
  193. is_constintnode:=(p.nodetype=ordconstn) and is_integer(p.resulttype.def);
  194. end;
  195. function is_constcharnode(p : tnode) : boolean;
  196. begin
  197. is_constcharnode:=(p.nodetype=ordconstn) and is_char(p.resulttype.def);
  198. end;
  199. function is_constwidecharnode(p : tnode) : boolean;
  200. begin
  201. is_constwidecharnode:=(p.nodetype=ordconstn) and is_widechar(p.resulttype.def);
  202. end;
  203. function is_constrealnode(p : tnode) : boolean;
  204. begin
  205. is_constrealnode:=(p.nodetype=realconstn);
  206. end;
  207. function is_constboolnode(p : tnode) : boolean;
  208. begin
  209. is_constboolnode:=(p.nodetype=ordconstn) and is_boolean(p.resulttype.def);
  210. end;
  211. function is_constresourcestringnode(p : tnode) : boolean;
  212. begin
  213. is_constresourcestringnode:=(p.nodetype=loadn) and
  214. (tloadnode(p).symtableentry.typ=constsym) and
  215. (tconstsym(tloadnode(p).symtableentry).consttyp=constresourcestring);
  216. end;
  217. function str_length(p : tnode) : longint;
  218. begin
  219. str_length:=tstringconstnode(p).len;
  220. end;
  221. {$ifdef oldset}
  222. function is_emptyset(p : tnode):boolean;
  223. var
  224. i : longint;
  225. begin
  226. i:=0;
  227. if p.nodetype=setconstn then
  228. begin
  229. while (i<32) and (tsetconstnode(p).value_set^[i]=0) do
  230. inc(i);
  231. end;
  232. is_emptyset:=(i=32);
  233. end;
  234. {$else}
  235. function is_emptyset(p : tnode):boolean;
  236. begin
  237. is_emptyset:=(p.nodetype=setconstn) and
  238. (Tsetconstnode(p).value_set^=[]);
  239. end;
  240. {$endif}
  241. function genconstsymtree(p : tconstsym) : tnode;
  242. var
  243. p1 : tnode;
  244. len : longint;
  245. pc : pchar;
  246. begin
  247. p1:=nil;
  248. case p.consttyp of
  249. constint :
  250. p1:=genintconstnode(p.valueord);
  251. conststring :
  252. begin
  253. len:=p.len;
  254. if not(cs_ansistrings in aktlocalswitches) and (len>255) then
  255. len:=255;
  256. getmem(pc,len+1);
  257. move(pchar(p.valueptr)^,pc^,len);
  258. pc[len]:=#0;
  259. p1:=cstringconstnode.createpchar(pc,len);
  260. end;
  261. constchar :
  262. p1:=cordconstnode.create(p.valueord,cchartype);
  263. constreal :
  264. p1:=crealconstnode.create(pbestreal(p.valueptr)^,pbestrealtype^);
  265. constbool :
  266. p1:=cordconstnode.create(p.valueord,booltype);
  267. constset :
  268. p1:=csetconstnode.create(pconstset(p.valueptr),p.consttype);
  269. constord :
  270. p1:=cordconstnode.create(p.valueord,p.consttype);
  271. constpointer :
  272. p1:=cpointerconstnode.create(p.valueordptr,p.consttype);
  273. constnil :
  274. p1:=cnilnode.create;
  275. else
  276. internalerror(200205103);
  277. end;
  278. genconstsymtree:=p1;
  279. end;
  280. {*****************************************************************************
  281. TREALCONSTNODE
  282. *****************************************************************************}
  283. { generic code }
  284. { overridden by: }
  285. { i386 }
  286. constructor trealconstnode.create(v : bestreal;const t:ttype);
  287. begin
  288. inherited create(realconstn);
  289. restype:=t;
  290. value_real:=v;
  291. lab_real:=nil;
  292. end;
  293. constructor trealconstnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  294. begin
  295. inherited ppuload(t,ppufile);
  296. ppufile.gettype(restype);
  297. value_real:=ppufile.getreal;
  298. lab_real:=tasmlabel(ppufile.getasmsymbol);
  299. end;
  300. procedure trealconstnode.ppuwrite(ppufile:tcompilerppufile);
  301. begin
  302. inherited ppuwrite(ppufile);
  303. ppufile.puttype(restype);
  304. ppufile.putreal(value_real);
  305. ppufile.putasmsymbol(lab_real);
  306. end;
  307. procedure trealconstnode.derefimpl;
  308. begin
  309. inherited derefimpl;
  310. restype.resolve;
  311. objectlibrary.derefasmsymbol(lab_real);
  312. end;
  313. function trealconstnode.getcopy : tnode;
  314. var
  315. n : trealconstnode;
  316. begin
  317. n:=trealconstnode(inherited getcopy);
  318. n.value_real:=value_real;
  319. n.lab_real:=lab_real;
  320. getcopy:=n;
  321. end;
  322. function trealconstnode.det_resulttype:tnode;
  323. begin
  324. result:=nil;
  325. resulttype:=restype;
  326. end;
  327. function trealconstnode.pass_1 : tnode;
  328. begin
  329. result:=nil;
  330. location.loc:=LOC_CREFERENCE;
  331. { needs to be loaded into an FPU register }
  332. registersfpu:=1;
  333. end;
  334. function trealconstnode.docompare(p: tnode): boolean;
  335. begin
  336. docompare :=
  337. inherited docompare(p) and
  338. (value_real = trealconstnode(p).value_real);
  339. end;
  340. {*****************************************************************************
  341. TORDCONSTNODE
  342. *****************************************************************************}
  343. constructor tordconstnode.create(v : tconstexprint;const t:ttype);
  344. begin
  345. inherited create(ordconstn);
  346. value:=v;
  347. restype:=t;
  348. end;
  349. constructor tordconstnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  350. begin
  351. inherited ppuload(t,ppufile);
  352. ppufile.gettype(restype);
  353. value:=ppufile.getexprint;
  354. end;
  355. procedure tordconstnode.ppuwrite(ppufile:tcompilerppufile);
  356. begin
  357. inherited ppuwrite(ppufile);
  358. ppufile.puttype(restype);
  359. ppufile.putexprint(value);
  360. end;
  361. procedure tordconstnode.derefimpl;
  362. begin
  363. inherited derefimpl;
  364. restype.resolve;
  365. end;
  366. function tordconstnode.getcopy : tnode;
  367. var
  368. n : tordconstnode;
  369. begin
  370. n:=tordconstnode(inherited getcopy);
  371. n.value:=value;
  372. n.restype := restype;
  373. getcopy:=n;
  374. end;
  375. function tordconstnode.det_resulttype:tnode;
  376. begin
  377. result:=nil;
  378. resulttype:=restype;
  379. testrange(resulttype.def,value,false);
  380. end;
  381. function tordconstnode.pass_1 : tnode;
  382. begin
  383. result:=nil;
  384. if is_64bitint(resulttype.def) then
  385. location.loc:=LOC_CREFERENCE
  386. else
  387. location.loc:=LOC_CONSTANT;
  388. end;
  389. function tordconstnode.docompare(p: tnode): boolean;
  390. begin
  391. docompare :=
  392. inherited docompare(p) and
  393. (value = tordconstnode(p).value);
  394. end;
  395. {$ifdef extdebug}
  396. procedure Tordconstnode._dowrite;
  397. begin
  398. inherited _dowrite;
  399. system.write(writenodeindention,',value = ',value);
  400. end;
  401. {$endif}
  402. {*****************************************************************************
  403. TPOINTERCONSTNODE
  404. *****************************************************************************}
  405. constructor tpointerconstnode.create(v : TConstPtrUInt;const t:ttype);
  406. begin
  407. inherited create(pointerconstn);
  408. value:=v;
  409. restype:=t;
  410. end;
  411. constructor tpointerconstnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  412. begin
  413. inherited ppuload(t,ppufile);
  414. ppufile.gettype(restype);
  415. value:=ppufile.getptruint;
  416. end;
  417. procedure tpointerconstnode.ppuwrite(ppufile:tcompilerppufile);
  418. begin
  419. inherited ppuwrite(ppufile);
  420. ppufile.puttype(restype);
  421. ppufile.putptruint(value);
  422. end;
  423. procedure tpointerconstnode.derefimpl;
  424. begin
  425. inherited derefimpl;
  426. restype.resolve;
  427. end;
  428. function tpointerconstnode.getcopy : tnode;
  429. var
  430. n : tpointerconstnode;
  431. begin
  432. n:=tpointerconstnode(inherited getcopy);
  433. n.value:=value;
  434. n.restype := restype;
  435. getcopy:=n;
  436. end;
  437. function tpointerconstnode.det_resulttype:tnode;
  438. begin
  439. result:=nil;
  440. resulttype:=restype;
  441. end;
  442. function tpointerconstnode.pass_1 : tnode;
  443. begin
  444. result:=nil;
  445. location.loc:=LOC_CONSTANT;
  446. end;
  447. function tpointerconstnode.docompare(p: tnode): boolean;
  448. begin
  449. docompare :=
  450. inherited docompare(p) and
  451. (value = tpointerconstnode(p).value);
  452. end;
  453. {*****************************************************************************
  454. TSTRINGCONSTNODE
  455. *****************************************************************************}
  456. constructor tstringconstnode.createstr(const s : string;st:tstringtype);
  457. var
  458. l : longint;
  459. begin
  460. inherited create(stringconstn);
  461. l:=length(s);
  462. len:=l;
  463. { stringdup write even past a #0 }
  464. getmem(value_str,l+1);
  465. move(s[1],value_str^,l);
  466. value_str[l]:=#0;
  467. lab_str:=nil;
  468. if st=st_default then
  469. begin
  470. if cs_ansistrings in aktlocalswitches then
  471. st_type:=st_ansistring
  472. else
  473. st_type:=st_shortstring;
  474. end
  475. else
  476. st_type:=st;
  477. end;
  478. constructor tstringconstnode.createwstr(w : pcompilerwidestring);
  479. begin
  480. inherited create(stringconstn);
  481. len:=getlengthwidestring(w);
  482. initwidestring(pcompilerwidestring(value_str));
  483. copywidestring(w,pcompilerwidestring(value_str));
  484. lab_str:=nil;
  485. st_type:=st_widestring;
  486. end;
  487. constructor tstringconstnode.createpchar(s : pchar;l : longint);
  488. begin
  489. inherited create(stringconstn);
  490. len:=l;
  491. value_str:=s;
  492. if (cs_ansistrings in aktlocalswitches) or
  493. (len>255) then
  494. st_type:=st_ansistring
  495. else
  496. st_type:=st_shortstring;
  497. lab_str:=nil;
  498. end;
  499. destructor tstringconstnode.destroy;
  500. begin
  501. if st_type=st_widestring then
  502. donewidestring(pcompilerwidestring(value_str))
  503. else
  504. ansistringdispose(value_str,len);
  505. inherited destroy;
  506. end;
  507. constructor tstringconstnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  508. begin
  509. inherited ppuload(t,ppufile);
  510. st_type:=tstringtype(ppufile.getbyte);
  511. len:=ppufile.getlongint;
  512. getmem(value_str,len+1);
  513. ppufile.getdata(value_str^,len);
  514. value_str[len]:=#0;
  515. lab_str:=tasmlabel(ppufile.getasmsymbol);
  516. end;
  517. procedure tstringconstnode.ppuwrite(ppufile:tcompilerppufile);
  518. begin
  519. inherited ppuwrite(ppufile);
  520. ppufile.putbyte(byte(st_type));
  521. ppufile.putlongint(len);
  522. ppufile.putdata(value_str^,len);
  523. ppufile.putasmsymbol(lab_str);
  524. end;
  525. procedure tstringconstnode.derefimpl;
  526. begin
  527. inherited derefimpl;
  528. objectlibrary.derefasmsymbol(lab_str);
  529. end;
  530. function tstringconstnode.getcopy : tnode;
  531. var
  532. n : tstringconstnode;
  533. begin
  534. n:=tstringconstnode(inherited getcopy);
  535. n.st_type:=st_type;
  536. n.len:=len;
  537. n.lab_str:=lab_str;
  538. if st_type=st_widestring then
  539. begin
  540. initwidestring(pcompilerwidestring(n.value_str));
  541. copywidestring(pcompilerwidestring(value_str),pcompilerwidestring(n.value_str));
  542. end
  543. else
  544. n.value_str:=getpcharcopy;
  545. getcopy:=n;
  546. end;
  547. function tstringconstnode.det_resulttype:tnode;
  548. begin
  549. result:=nil;
  550. case st_type of
  551. st_shortstring :
  552. resulttype:=cshortstringtype;
  553. st_ansistring :
  554. resulttype:=cansistringtype;
  555. st_widestring :
  556. resulttype:=cwidestringtype;
  557. st_longstring :
  558. resulttype:=clongstringtype;
  559. end;
  560. end;
  561. function tstringconstnode.pass_1 : tnode;
  562. begin
  563. result:=nil;
  564. location.loc:=LOC_CREFERENCE;
  565. end;
  566. function tstringconstnode.getpcharcopy : pchar;
  567. var
  568. pc : pchar;
  569. begin
  570. pc:=nil;
  571. getmem(pc,len+1);
  572. if pc=nil then
  573. Message(general_f_no_memory_left);
  574. move(value_str^,pc^,len+1);
  575. getpcharcopy:=pc;
  576. end;
  577. function tstringconstnode.docompare(p: tnode): boolean;
  578. begin
  579. docompare :=
  580. inherited docompare(p) and
  581. (len = tstringconstnode(p).len) and
  582. { Don't compare the pchars, since they may contain null chars }
  583. { Since all equal constant strings are replaced by the same }
  584. { label, the following compare should be enough (JM) }
  585. (lab_str = tstringconstnode(p).lab_str);
  586. end;
  587. {*****************************************************************************
  588. TSETCONSTNODE
  589. *****************************************************************************}
  590. constructor tsetconstnode.create(s : pconstset;const t:ttype);
  591. begin
  592. inherited create(setconstn,nil);
  593. restype:=t;
  594. if assigned(s) then
  595. begin
  596. new(value_set);
  597. value_set^:=s^;
  598. end
  599. else
  600. value_set:=nil;
  601. end;
  602. destructor tsetconstnode.destroy;
  603. begin
  604. if assigned(value_set) then
  605. dispose(value_set);
  606. inherited destroy;
  607. end;
  608. constructor tsetconstnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  609. begin
  610. inherited ppuload(t,ppufile);
  611. ppufile.gettype(restype);
  612. new(value_set);
  613. ppufile.getdata(value_set^,sizeof(tconstset));
  614. end;
  615. procedure tsetconstnode.ppuwrite(ppufile:tcompilerppufile);
  616. begin
  617. inherited ppuwrite(ppufile);
  618. ppufile.puttype(restype);
  619. ppufile.putdata(value_set^,sizeof(tconstset));
  620. end;
  621. procedure tsetconstnode.derefimpl;
  622. begin
  623. inherited derefimpl;
  624. restype.resolve;
  625. end;
  626. function tsetconstnode.getcopy : tnode;
  627. var
  628. n : tsetconstnode;
  629. begin
  630. n:=tsetconstnode(inherited getcopy);
  631. if assigned(value_set) then
  632. begin
  633. new(n.value_set);
  634. n.value_set^:=value_set^
  635. end
  636. else
  637. n.value_set:=nil;
  638. n.restype := restype;
  639. n.lab_set:=lab_set;
  640. getcopy:=n;
  641. end;
  642. function tsetconstnode.det_resulttype:tnode;
  643. begin
  644. result:=nil;
  645. resulttype:=restype;
  646. end;
  647. function tsetconstnode.pass_1 : tnode;
  648. begin
  649. result:=nil;
  650. if tsetdef(resulttype.def).settype=smallset then
  651. location.loc:=LOC_CONSTANT
  652. else
  653. location.loc:=LOC_CREFERENCE;
  654. end;
  655. {$ifdef oldset}
  656. function tsetconstnode.docompare(p: tnode): boolean;
  657. var
  658. i: 0..31;
  659. begin
  660. if inherited docompare(p) then
  661. begin
  662. for i := 0 to 31 do
  663. if (value_set^[i] <> tsetconstnode(p).value_set^[i]) then
  664. begin
  665. docompare := false;
  666. exit
  667. end;
  668. docompare := true;
  669. end
  670. else
  671. docompare := false;
  672. end;
  673. {$else}
  674. function tsetconstnode.docompare(p: tnode): boolean;
  675. begin
  676. docompare:=(inherited docompare(p))
  677. and (value_set^=Tsetconstnode(p).value_set^);
  678. end;
  679. {$endif}
  680. {*****************************************************************************
  681. TNILNODE
  682. *****************************************************************************}
  683. constructor tnilnode.create;
  684. begin
  685. inherited create(niln);
  686. end;
  687. function tnilnode.det_resulttype:tnode;
  688. begin
  689. result:=nil;
  690. resulttype:=voidpointertype;
  691. end;
  692. function tnilnode.pass_1 : tnode;
  693. begin
  694. result:=nil;
  695. location.loc:=LOC_CONSTANT;
  696. end;
  697. {*****************************************************************************
  698. TGUIDCONSTNODE
  699. *****************************************************************************}
  700. constructor tguidconstnode.create(const g:tguid);
  701. begin
  702. inherited create(guidconstn);
  703. value:=g;
  704. end;
  705. constructor tguidconstnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  706. begin
  707. inherited ppuload(t,ppufile);
  708. ppufile.getguid(value);
  709. end;
  710. procedure tguidconstnode.ppuwrite(ppufile:tcompilerppufile);
  711. begin
  712. inherited ppuwrite(ppufile);
  713. ppufile.putguid(value);
  714. end;
  715. function tguidconstnode.getcopy : tnode;
  716. var
  717. n : tguidconstnode;
  718. begin
  719. n:=tguidconstnode(inherited getcopy);
  720. n.value:=value;
  721. getcopy:=n;
  722. end;
  723. function tguidconstnode.det_resulttype:tnode;
  724. begin
  725. result:=nil;
  726. resulttype.setdef(rec_tguid);
  727. end;
  728. function tguidconstnode.pass_1 : tnode;
  729. begin
  730. result:=nil;
  731. location.loc:=LOC_CREFERENCE;
  732. end;
  733. function tguidconstnode.docompare(p: tnode): boolean;
  734. begin
  735. docompare :=
  736. inherited docompare(p) and
  737. (guid2string(value) = guid2string(tguidconstnode(p).value));
  738. end;
  739. begin
  740. crealconstnode:=trealconstnode;
  741. cordconstnode:=tordconstnode;
  742. cpointerconstnode:=tpointerconstnode;
  743. cstringconstnode:=tstringconstnode;
  744. csetconstnode:=tsetconstnode;
  745. cnilnode:=tnilnode;
  746. cguidconstnode:=tguidconstnode;
  747. end.
  748. {
  749. $Log$
  750. Revision 1.39 2002-08-18 20:06:23 peter
  751. * inlining is now also allowed in interface
  752. * renamed write/load to ppuwrite/ppuload
  753. * tnode storing in ppu
  754. * nld,ncon,nbas are already updated for storing in ppu
  755. Revision 1.38 2002/08/17 22:09:45 florian
  756. * result type handling in tcgcal.pass_2 overhauled
  757. * better tnode.dowrite
  758. * some ppc stuff fixed
  759. Revision 1.37 2002/07/23 12:34:30 daniel
  760. * Readded old set code. To use it define 'oldset'. Activated by default
  761. for ppc.
  762. Revision 1.36 2002/07/22 11:48:04 daniel
  763. * Sets are now internally sets.
  764. Revision 1.35 2002/07/20 11:57:54 florian
  765. * types.pas renamed to defbase.pas because D6 contains a types
  766. unit so this would conflicts if D6 programms are compiled
  767. + Willamette/SSE2 instructions to assembler added
  768. Revision 1.34 2002/07/14 18:00:43 daniel
  769. + Added the beginning of a state tracker. This will track the values of
  770. variables through procedures and optimize things away.
  771. Revision 1.33 2002/07/01 18:46:23 peter
  772. * internal linker
  773. * reorganized aasm layer
  774. Revision 1.32 2002/05/18 13:34:09 peter
  775. * readded missing revisions
  776. Revision 1.31 2002/05/16 19:46:37 carl
  777. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  778. + try to fix temp allocation (still in ifdef)
  779. + generic constructor calls
  780. + start of tassembler / tmodulebase class cleanup
  781. Revision 1.29 2002/05/12 16:53:07 peter
  782. * moved entry and exitcode to ncgutil and cgobj
  783. * foreach gets extra argument for passing local data to the
  784. iterator function
  785. * -CR checks also class typecasts at runtime by changing them
  786. into as
  787. * fixed compiler to cycle with the -CR option
  788. * fixed stabs with elf writer, finally the global variables can
  789. be watched
  790. * removed a lot of routines from cga unit and replaced them by
  791. calls to cgobj
  792. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  793. u32bit then the other is typecasted also to u32bit without giving
  794. a rangecheck warning/error.
  795. * fixed pascal calling method with reversing also the high tree in
  796. the parast, detected by tcalcst3 test
  797. Revision 1.28 2002/04/07 13:25:20 carl
  798. + change unit use
  799. Revision 1.27 2002/04/04 19:05:58 peter
  800. * removed unused units
  801. * use tlocation.size in cg.a_*loc*() routines
  802. Revision 1.26 2002/04/02 17:11:29 peter
  803. * tlocation,treference update
  804. * LOC_CONSTANT added for better constant handling
  805. * secondadd splitted in multiple routines
  806. * location_force_reg added for loading a location to a register
  807. of a specified size
  808. * secondassignment parses now first the right and then the left node
  809. (this is compatible with Kylix). This saves a lot of push/pop especially
  810. with string operations
  811. * adapted some routines to use the new cg methods
  812. Revision 1.25 2002/03/04 19:10:11 peter
  813. * removed compiler warnings
  814. }