node.pas 33 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175
  1. {
  2. $Id$
  3. Copyright (c) 2000-2002 by Florian Klaempfl
  4. Basic node handling
  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 node;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. cclasses,
  23. globtype,globals,
  24. cpubase,cgbase,cgutils,
  25. aasmbase,
  26. symtype;
  27. type
  28. pconstset = ^tconstset;
  29. tconstset = set of 0..255;
  30. tnodetype = (
  31. emptynode, {No node (returns nil when loading from ppu)}
  32. addn, {Represents the + operator}
  33. muln, {Represents the * operator}
  34. subn, {Represents the - operator}
  35. divn, {Represents the div operator}
  36. symdifn, {Represents the >< operator}
  37. modn, {Represents the mod operator}
  38. assignn, {Represents an assignment}
  39. loadn, {Represents the use of a variabele}
  40. rangen, {Represents a range (i.e. 0..9)}
  41. ltn, {Represents the < operator}
  42. lten, {Represents the <= operator}
  43. gtn, {Represents the > operator}
  44. gten, {Represents the >= operator}
  45. equaln, {Represents the = operator}
  46. unequaln, {Represents the <> operator}
  47. inn, {Represents the in operator}
  48. orn, {Represents the or operator}
  49. xorn, {Represents the xor operator}
  50. shrn, {Represents the shr operator}
  51. shln, {Represents the shl operator}
  52. slashn, {Represents the / operator}
  53. andn, {Represents the and operator}
  54. subscriptn, {Field in a record/object}
  55. derefn, {Dereferences a pointer}
  56. addrn, {Represents the @ operator}
  57. ordconstn, {Represents an ordinal value}
  58. typeconvn, {Represents type-conversion/typecast}
  59. calln, {Represents a call node}
  60. callparan, {Represents a parameter}
  61. realconstn, {Represents a real value}
  62. unaryminusn, {Represents a sign change (i.e. -2)}
  63. asmn, {Represents an assembler node }
  64. vecn, {Represents array indexing}
  65. pointerconstn, {Represents a pointer constant}
  66. stringconstn, {Represents a string constant}
  67. notn, {Represents the not operator}
  68. inlinen, {Internal procedures (i.e. writeln)}
  69. niln, {Represents the nil pointer}
  70. errorn, {This part of the tree could not be
  71. parsed because of a compiler error}
  72. typen, {A type name. Used for i.e. typeof(obj)}
  73. setelementn, {A set element(s) (i.e. [a,b] and also [a..b])}
  74. setconstn, {A set constant (i.e. [1,2])}
  75. blockn, {A block of statements}
  76. statementn, {One statement in a block of nodes}
  77. ifn, {An if statement}
  78. breakn, {A break statement}
  79. continuen, {A continue statement}
  80. whilerepeatn, {A while or repeat statement}
  81. forn, {A for loop}
  82. exitn, {An exit statement}
  83. withn, {A with statement}
  84. casen, {A case statement}
  85. labeln, {A label}
  86. goton, {A goto statement}
  87. tryexceptn, {A try except block}
  88. raisen, {A raise statement}
  89. tryfinallyn, {A try finally statement}
  90. onn, {For an on statement in exception code}
  91. isn, {Represents the is operator}
  92. asn, {Represents the as typecast}
  93. caretn, {Represents the ^ operator}
  94. starstarn, {Represents the ** operator exponentiation }
  95. arrayconstructorn, {Construction node for [...] parsing}
  96. arrayconstructorrangen, {Range element to allow sets in array construction tree}
  97. tempcreaten, { for temps in the result/firstpass }
  98. temprefn, { references to temps }
  99. tempdeleten, { for temps in the result/firstpass }
  100. addoptn, { added for optimizations where we cannot suppress }
  101. nothingn, {NOP, Do nothing}
  102. loadvmtaddrn, {Load the address of the VMT of a class/object}
  103. guidconstn, {A GUID COM Interface constant }
  104. rttin, {Rtti information so they can be accessed in result/firstpass}
  105. loadparentfpn { Load the framepointer of the parent for nested procedures }
  106. );
  107. const
  108. nodetype2str : array[tnodetype] of string[24] = (
  109. '<emptynode>',
  110. 'addn',
  111. 'muln',
  112. 'subn',
  113. 'divn',
  114. 'symdifn',
  115. 'modn',
  116. 'assignn',
  117. 'loadn',
  118. 'rangen',
  119. 'ltn',
  120. 'lten',
  121. 'gtn',
  122. 'gten',
  123. 'equaln',
  124. 'unequaln',
  125. 'inn',
  126. 'orn',
  127. 'xorn',
  128. 'shrn',
  129. 'shln',
  130. 'slashn',
  131. 'andn',
  132. 'subscriptn',
  133. 'derefn',
  134. 'addrn',
  135. 'ordconstn',
  136. 'typeconvn',
  137. 'calln',
  138. 'callparan',
  139. 'realconstn',
  140. 'unaryminusn',
  141. 'asmn',
  142. 'vecn',
  143. 'pointerconstn',
  144. 'stringconstn',
  145. 'notn',
  146. 'inlinen',
  147. 'niln',
  148. 'errorn',
  149. 'typen',
  150. 'setelementn',
  151. 'setconstn',
  152. 'blockn',
  153. 'statementn',
  154. 'ifn',
  155. 'breakn',
  156. 'continuen',
  157. 'whilerepeatn',
  158. 'forn',
  159. 'exitn',
  160. 'withn',
  161. 'casen',
  162. 'labeln',
  163. 'goton',
  164. 'tryexceptn',
  165. 'raisen',
  166. 'tryfinallyn',
  167. 'onn',
  168. 'isn',
  169. 'asn',
  170. 'caretn',
  171. 'starstarn',
  172. 'arrayconstructn',
  173. 'arrayconstructrangen',
  174. 'tempcreaten',
  175. 'temprefn',
  176. 'tempdeleten',
  177. 'addoptn',
  178. 'nothingn',
  179. 'loadvmtaddrn',
  180. 'guidconstn',
  181. 'rttin',
  182. 'loadparentfpn');
  183. type
  184. { all boolean field of ttree are now collected in flags }
  185. tnodeflag = (
  186. nf_swapable, { tbinop operands can be swaped }
  187. nf_swaped, { tbinop operands are swaped }
  188. nf_error,
  189. { general }
  190. nf_pass1_done,
  191. nf_write, { Node is written to }
  192. nf_isproperty,
  193. { taddrnode }
  194. nf_typedaddr,
  195. { tderefnode }
  196. nf_no_checkpointer,
  197. { tvecnode }
  198. nf_memindex,
  199. nf_memseg,
  200. nf_callunique,
  201. { tloadnode }
  202. nf_absolute,
  203. nf_load_self_pointer,
  204. { taddnode }
  205. nf_is_currency,
  206. nf_has_pointerdiv,
  207. { tassignmentnode }
  208. nf_concat_string,
  209. nf_use_strconcat,
  210. { tarrayconstructnode }
  211. nf_forcevaria,
  212. nf_novariaallowed,
  213. { ttypeconvnode }
  214. nf_explicit,
  215. nf_internal, { no warnings/hints generated }
  216. nf_load_procvar,
  217. { tinlinenode }
  218. nf_inlineconst,
  219. { tasmnode }
  220. nf_get_asm_position,
  221. { tblocknode }
  222. nf_block_with_exit
  223. );
  224. tnodeflags = set of tnodeflag;
  225. const
  226. { contains the flags which must be equal for the equality }
  227. { of nodes }
  228. flagsequal : tnodeflags = [nf_error];
  229. type
  230. tnodelist = class
  231. end;
  232. { later (for the newcg) tnode will inherit from tlinkedlist_item }
  233. tnode = class
  234. public
  235. { type of this node }
  236. nodetype : tnodetype;
  237. { type of the current code block, general/const/type }
  238. blocktype : tblock_type;
  239. { expected location of the result of this node (pass1) }
  240. expectloc : tcgloc;
  241. { the location of the result of this node (pass2) }
  242. location : tlocation;
  243. { the parent node of this is node }
  244. { this field is set by concattolist }
  245. parent : tnode;
  246. { there are some properties about the node stored }
  247. flags : tnodeflags;
  248. ppuidx : longint;
  249. { the number of registers needed to evalute the node }
  250. registersint,registersfpu,registersmm : longint; { must be longint !!!! }
  251. {$ifdef SUPPORT_MMX}
  252. registersmmx : longint;
  253. {$endif SUPPORT_MMX}
  254. resulttype : ttype;
  255. fileinfo : tfileposinfo;
  256. localswitches : tlocalswitches;
  257. {$ifdef extdebug}
  258. maxfirstpasscount,
  259. firstpasscount : longint;
  260. {$endif extdebug}
  261. constructor create(t:tnodetype);
  262. { this constructor is only for creating copies of class }
  263. { the fields are copied by getcopy }
  264. constructor createforcopy;
  265. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);virtual;
  266. destructor destroy;override;
  267. procedure ppuwrite(ppufile:tcompilerppufile);virtual;
  268. procedure buildderefimpl;virtual;
  269. procedure derefimpl;virtual;
  270. procedure derefnode;virtual;
  271. { toggles the flag }
  272. procedure toggleflag(f : tnodeflag);
  273. { the 1.1 code generator may override pass_1 }
  274. { and it need not to implement det_* then }
  275. { 1.1: pass_1 returns a value<>0 if the node has been transformed }
  276. { 2.0: runs det_resulttype and det_temp }
  277. function pass_1 : tnode;virtual;abstract;
  278. { dermines the resulttype of the node }
  279. function det_resulttype : tnode;virtual;abstract;
  280. { dermines the number of necessary temp. locations to evaluate
  281. the node }
  282. {$ifdef state_tracking}
  283. { Does optimizations by keeping track of the variable states
  284. in a procedure }
  285. function track_state_pass(exec_known:boolean):boolean;virtual;
  286. {$endif}
  287. { For a t1:=t2 tree, mark the part of the tree t1 that gets
  288. written to (normally the loadnode) as write access. }
  289. procedure mark_write;virtual;
  290. procedure det_temp;virtual;abstract;
  291. procedure pass_2;virtual;abstract;
  292. { comparing of nodes }
  293. function isequal(p : tnode) : boolean;
  294. { to implement comparisation, override this method }
  295. function docompare(p : tnode) : boolean;virtual;
  296. { gets a copy of the node }
  297. function getcopy : tnode;virtual;
  298. procedure insertintolist(l : tnodelist);virtual;
  299. { writes a node for debugging purpose, shouldn't be called }
  300. { direct, because there is no test for nil, use printnode }
  301. { to write a complete tree }
  302. procedure printnodeinfo(var t:text);virtual;
  303. procedure printnodedata(var t:text);virtual;
  304. procedure printnodetree(var t:text);virtual;
  305. procedure concattolist(l : tlinkedlist);virtual;
  306. function ischild(p : tnode) : boolean;virtual;
  307. end;
  308. tnodeclass = class of tnode;
  309. tnodeclassarray = array[tnodetype] of tnodeclass;
  310. { this node is the anchestor for all nodes with at least }
  311. { one child, you have to use it if you want to use }
  312. { true- and falselabel }
  313. punarynode = ^tunarynode;
  314. tunarynode = class(tnode)
  315. left : tnode;
  316. constructor create(t:tnodetype;l : tnode);
  317. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  318. destructor destroy;override;
  319. procedure ppuwrite(ppufile:tcompilerppufile);override;
  320. procedure buildderefimpl;override;
  321. procedure derefimpl;override;
  322. procedure derefnode;override;
  323. procedure concattolist(l : tlinkedlist);override;
  324. function ischild(p : tnode) : boolean;override;
  325. function docompare(p : tnode) : boolean;override;
  326. function getcopy : tnode;override;
  327. procedure insertintolist(l : tnodelist);override;
  328. procedure left_max;
  329. procedure printnodedata(var t:text);override;
  330. end;
  331. pbinarynode = ^tbinarynode;
  332. tbinarynode = class(tunarynode)
  333. right : tnode;
  334. constructor create(t:tnodetype;l,r : tnode);
  335. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  336. destructor destroy;override;
  337. procedure ppuwrite(ppufile:tcompilerppufile);override;
  338. procedure buildderefimpl;override;
  339. procedure derefimpl;override;
  340. procedure derefnode;override;
  341. procedure concattolist(l : tlinkedlist);override;
  342. function ischild(p : tnode) : boolean;override;
  343. function docompare(p : tnode) : boolean;override;
  344. procedure swapleftright;
  345. function getcopy : tnode;override;
  346. procedure insertintolist(l : tnodelist);override;
  347. procedure left_right_max;
  348. procedure printnodedata(var t:text);override;
  349. procedure printnodelist(var t:text);
  350. end;
  351. tbinopnode = class(tbinarynode)
  352. constructor create(t:tnodetype;l,r : tnode);virtual;
  353. function docompare(p : tnode) : boolean;override;
  354. end;
  355. var
  356. { array with all class types for tnodes }
  357. nodeclass : tnodeclassarray;
  358. function nodeppuidxget(i:longint):tnode;
  359. function ppuloadnode(ppufile:tcompilerppufile):tnode;
  360. procedure ppuwritenode(ppufile:tcompilerppufile;n:tnode);
  361. function ppuloadnodetree(ppufile:tcompilerppufile):tnode;
  362. procedure ppuwritenodetree(ppufile:tcompilerppufile;n:tnode);
  363. const
  364. printnodespacing = ' ';
  365. var
  366. { indention used when writing the tree to the screen }
  367. printnodeindention : string;
  368. procedure printnodeindent;
  369. procedure printnodeunindent;
  370. procedure printnode(var t:text;n:tnode);
  371. function is_constnode(p : tnode) : boolean;
  372. function is_constintnode(p : tnode) : boolean;
  373. function is_constcharnode(p : tnode) : boolean;
  374. function is_constrealnode(p : tnode) : boolean;
  375. function is_constboolnode(p : tnode) : boolean;
  376. function is_constenumnode(p : tnode) : boolean;
  377. function is_constwidecharnode(p : tnode) : boolean;
  378. implementation
  379. uses
  380. cutils,verbose,ppu,
  381. symconst,
  382. defutil;
  383. const
  384. ppunodemarker = 255;
  385. {****************************************************************************
  386. Helpers
  387. ****************************************************************************}
  388. var
  389. nodeppudata : tdynamicarray;
  390. nodeppuidx : longint;
  391. procedure nodeppuidxcreate;
  392. begin
  393. nodeppudata:=tdynamicarray.create(1024);
  394. nodeppuidx:=0;
  395. end;
  396. procedure nodeppuidxfree;
  397. begin
  398. nodeppudata.free;
  399. nodeppudata:=nil;
  400. end;
  401. procedure nodeppuidxadd(n:tnode);
  402. begin
  403. if n.ppuidx<0 then
  404. internalerror(200311072);
  405. nodeppudata.seek(n.ppuidx*sizeof(pointer));
  406. nodeppudata.write(n,sizeof(pointer));
  407. end;
  408. function nodeppuidxget(i:longint):tnode;
  409. var
  410. l : longint;
  411. begin
  412. if i<0 then
  413. internalerror(200311072);
  414. nodeppudata.seek(i*sizeof(pointer));
  415. if nodeppudata.read(result,sizeof(pointer))<>sizeof(pointer) then
  416. internalerror(200311073);
  417. end;
  418. function ppuloadnode(ppufile:tcompilerppufile):tnode;
  419. var
  420. b : byte;
  421. t : tnodetype;
  422. hppuidx : longint;
  423. begin
  424. { marker }
  425. b:=ppufile.getbyte;
  426. if b<>ppunodemarker then
  427. internalerror(200208151);
  428. { load nodetype }
  429. t:=tnodetype(ppufile.getbyte);
  430. if t>high(tnodetype) then
  431. internalerror(200208152);
  432. if t<>emptynode then
  433. begin
  434. if not assigned(nodeclass[t]) then
  435. internalerror(200208153);
  436. hppuidx:=ppufile.getlongint;
  437. //writeln('load: ',nodetype2str[t]);
  438. { generate node of the correct class }
  439. result:=nodeclass[t].ppuload(t,ppufile);
  440. result.ppuidx:=hppuidx;
  441. nodeppuidxadd(result);
  442. end
  443. else
  444. result:=nil;
  445. end;
  446. procedure ppuwritenode(ppufile:tcompilerppufile;n:tnode);
  447. begin
  448. { marker, read by ppuloadnode }
  449. ppufile.putbyte(ppunodemarker);
  450. { type, read by ppuloadnode }
  451. if assigned(n) then
  452. begin
  453. if n.ppuidx=-1 then
  454. internalerror(200311071);
  455. n.ppuidx:=nodeppuidx;
  456. inc(nodeppuidx);
  457. ppufile.putbyte(byte(n.nodetype));
  458. ppufile.putlongint(n.ppuidx);
  459. //writeln('write: ',nodetype2str[n.nodetype]);
  460. n.ppuwrite(ppufile);
  461. end
  462. else
  463. ppufile.putbyte(byte(emptynode));
  464. end;
  465. function ppuloadnodetree(ppufile:tcompilerppufile):tnode;
  466. begin
  467. if ppufile.readentry<>ibnodetree then
  468. Message(unit_f_ppu_read_error);
  469. nodeppuidxcreate;
  470. result:=ppuloadnode(ppufile);
  471. result.derefnode;
  472. nodeppuidxfree;
  473. end;
  474. procedure ppuwritenodetree(ppufile:tcompilerppufile;n:tnode);
  475. begin
  476. nodeppuidx:=0;
  477. ppuwritenode(ppufile,n);
  478. ppufile.writeentry(ibnodetree);
  479. end;
  480. procedure printnodeindent;
  481. begin
  482. printnodeindention:=printnodeindention+printnodespacing;
  483. end;
  484. procedure printnodeunindent;
  485. begin
  486. delete(printnodeindention,1,length(printnodespacing));
  487. end;
  488. procedure printnode(var t:text;n:tnode);
  489. begin
  490. if assigned(n) then
  491. n.printnodetree(t)
  492. else
  493. writeln(t,printnodeindention,'nil');
  494. end;
  495. function is_constnode(p : tnode) : boolean;
  496. begin
  497. is_constnode:=(p.nodetype in [niln,ordconstn,realconstn,stringconstn,setconstn,guidconstn]);
  498. end;
  499. function is_constintnode(p : tnode) : boolean;
  500. begin
  501. is_constintnode:=(p.nodetype=ordconstn) and is_integer(p.resulttype.def);
  502. end;
  503. function is_constcharnode(p : tnode) : boolean;
  504. begin
  505. is_constcharnode:=(p.nodetype=ordconstn) and is_char(p.resulttype.def);
  506. end;
  507. function is_constwidecharnode(p : tnode) : boolean;
  508. begin
  509. is_constwidecharnode:=(p.nodetype=ordconstn) and is_widechar(p.resulttype.def);
  510. end;
  511. function is_constrealnode(p : tnode) : boolean;
  512. begin
  513. is_constrealnode:=(p.nodetype=realconstn);
  514. end;
  515. function is_constboolnode(p : tnode) : boolean;
  516. begin
  517. is_constboolnode:=(p.nodetype=ordconstn) and is_boolean(p.resulttype.def);
  518. end;
  519. function is_constenumnode(p : tnode) : boolean;
  520. begin
  521. is_constenumnode:=(p.nodetype=ordconstn) and (p.resulttype.def.deftype=enumdef);
  522. end;
  523. {****************************************************************************
  524. TNODE
  525. ****************************************************************************}
  526. constructor tnode.create(t:tnodetype);
  527. begin
  528. inherited create;
  529. nodetype:=t;
  530. blocktype:=block_type;
  531. { updated by firstpass }
  532. expectloc:=LOC_INVALID;
  533. { updated by secondpass }
  534. location.loc:=LOC_INVALID;
  535. { save local info }
  536. fileinfo:=aktfilepos;
  537. localswitches:=aktlocalswitches;
  538. resulttype.reset;
  539. registersint:=0;
  540. registersfpu:=0;
  541. {$ifdef SUPPORT_MMX}
  542. registersmmx:=0;
  543. {$endif SUPPORT_MMX}
  544. {$ifdef EXTDEBUG}
  545. maxfirstpasscount:=0;
  546. firstpasscount:=0;
  547. {$endif EXTDEBUG}
  548. flags:=[];
  549. ppuidx:=-1;
  550. end;
  551. constructor tnode.createforcopy;
  552. begin
  553. end;
  554. constructor tnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  555. begin
  556. nodetype:=t;
  557. { tnode fields }
  558. blocktype:=tblock_type(ppufile.getbyte);
  559. ppufile.getposinfo(fileinfo);
  560. ppufile.getsmallset(localswitches);
  561. ppufile.gettype(resulttype);
  562. ppufile.getsmallset(flags);
  563. { updated by firstpass }
  564. expectloc:=LOC_INVALID;
  565. { updated by secondpass }
  566. location.loc:=LOC_INVALID;
  567. registersint:=0;
  568. registersfpu:=0;
  569. {$ifdef SUPPORT_MMX}
  570. registersmmx:=0;
  571. {$endif SUPPORT_MMX}
  572. {$ifdef EXTDEBUG}
  573. maxfirstpasscount:=0;
  574. firstpasscount:=0;
  575. {$endif EXTDEBUG}
  576. ppuidx:=-1;
  577. end;
  578. procedure tnode.ppuwrite(ppufile:tcompilerppufile);
  579. begin
  580. ppufile.putbyte(byte(block_type));
  581. ppufile.putposinfo(fileinfo);
  582. ppufile.putsmallset(localswitches);
  583. ppufile.puttype(resulttype);
  584. ppufile.putsmallset(flags);
  585. end;
  586. procedure tnode.buildderefimpl;
  587. begin
  588. resulttype.buildderef;
  589. end;
  590. procedure tnode.derefimpl;
  591. begin
  592. resulttype.resolve;
  593. end;
  594. procedure tnode.derefnode;
  595. begin
  596. end;
  597. procedure tnode.toggleflag(f : tnodeflag);
  598. begin
  599. if f in flags then
  600. exclude(flags,f)
  601. else
  602. include(flags,f);
  603. end;
  604. destructor tnode.destroy;
  605. begin
  606. {$ifdef EXTDEBUG}
  607. if firstpasscount>maxfirstpasscount then
  608. maxfirstpasscount:=firstpasscount;
  609. {$endif EXTDEBUG}
  610. end;
  611. procedure tnode.concattolist(l : tlinkedlist);
  612. begin
  613. end;
  614. function tnode.ischild(p : tnode) : boolean;
  615. begin
  616. ischild:=false;
  617. end;
  618. procedure tnode.mark_write;
  619. begin
  620. {$ifdef EXTDEBUG}
  621. Comment(V_Warning,'mark_write not implemented for '+nodetype2str[nodetype]);
  622. {$endif EXTDEBUG}
  623. end;
  624. procedure tnode.printnodeinfo(var t:text);
  625. begin
  626. write(t,nodetype2str[nodetype]);
  627. if assigned(resulttype.def) then
  628. write(t,', resulttype = "',resulttype.def.gettypename,'"')
  629. else
  630. write(t,', resulttype = <nil>');
  631. write(t,', pos = (',fileinfo.line,',',fileinfo.column,')',
  632. ', loc = ',tcgloc2str[location.loc],
  633. ', expectloc = ',tcgloc2str[expectloc],
  634. ', intregs = ',registersint,
  635. ', fpuregs = ',registersfpu);
  636. end;
  637. procedure tnode.printnodedata(var t:text);
  638. begin
  639. end;
  640. procedure tnode.printnodetree(var t:text);
  641. begin
  642. write(t,printnodeindention,'(');
  643. printnodeinfo(t);
  644. writeln(t);
  645. printnodeindent;
  646. printnodedata(t);
  647. printnodeunindent;
  648. writeln(t,printnodeindention,')');
  649. end;
  650. function tnode.isequal(p : tnode) : boolean;
  651. begin
  652. isequal:=
  653. (not assigned(self) and not assigned(p)) or
  654. (assigned(self) and assigned(p) and
  655. { optimized subclasses have the same nodetype as their }
  656. { superclass (for compatibility), so also check the classtype (JM) }
  657. (p.classtype=classtype) and
  658. (p.nodetype=nodetype) and
  659. (flags*flagsequal=p.flags*flagsequal) and
  660. docompare(p));
  661. end;
  662. {$ifdef state_tracking}
  663. function Tnode.track_state_pass(exec_known:boolean):boolean;
  664. begin
  665. track_state_pass:=false;
  666. end;
  667. {$endif state_tracking}
  668. function tnode.docompare(p : tnode) : boolean;
  669. begin
  670. docompare:=true;
  671. end;
  672. function tnode.getcopy : tnode;
  673. var
  674. p : tnode;
  675. begin
  676. { this is quite tricky because we need a node of the current }
  677. { node type and not one of tnode! }
  678. p:=tnodeclass(classtype).createforcopy;
  679. p.nodetype:=nodetype;
  680. p.expectloc:=expectloc;
  681. p.location:=location;
  682. p.parent:=parent;
  683. p.flags:=flags;
  684. p.registersint:=registersint;
  685. p.registersfpu:=registersfpu;
  686. {$ifdef SUPPORT_MMX}
  687. p.registersmmx:=registersmmx;
  688. p.registerskni:=registerskni;
  689. {$endif SUPPORT_MMX}
  690. p.resulttype:=resulttype;
  691. p.fileinfo:=fileinfo;
  692. p.localswitches:=localswitches;
  693. {$ifdef extdebug}
  694. p.firstpasscount:=firstpasscount;
  695. {$endif extdebug}
  696. { p.list:=list; }
  697. getcopy:=p;
  698. end;
  699. procedure tnode.insertintolist(l : tnodelist);
  700. begin
  701. end;
  702. {****************************************************************************
  703. TUNARYNODE
  704. ****************************************************************************}
  705. constructor tunarynode.create(t:tnodetype;l : tnode);
  706. begin
  707. inherited create(t);
  708. left:=l;
  709. end;
  710. constructor tunarynode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  711. begin
  712. inherited ppuload(t,ppufile);
  713. left:=ppuloadnode(ppufile);
  714. end;
  715. destructor tunarynode.destroy;
  716. begin
  717. left.free;
  718. inherited destroy;
  719. end;
  720. procedure tunarynode.ppuwrite(ppufile:tcompilerppufile);
  721. begin
  722. inherited ppuwrite(ppufile);
  723. ppuwritenode(ppufile,left);
  724. end;
  725. procedure tunarynode.buildderefimpl;
  726. begin
  727. inherited buildderefimpl;
  728. if assigned(left) then
  729. left.buildderefimpl;
  730. end;
  731. procedure tunarynode.derefimpl;
  732. begin
  733. inherited derefimpl;
  734. if assigned(left) then
  735. left.derefimpl;
  736. end;
  737. procedure tunarynode.derefnode;
  738. begin
  739. inherited derefnode;
  740. if assigned(left) then
  741. left.derefnode;
  742. end;
  743. function tunarynode.docompare(p : tnode) : boolean;
  744. begin
  745. docompare:=(inherited docompare(p) and
  746. ((left=nil) or left.isequal(tunarynode(p).left))
  747. );
  748. end;
  749. function tunarynode.getcopy : tnode;
  750. var
  751. p : tunarynode;
  752. begin
  753. p:=tunarynode(inherited getcopy);
  754. if assigned(left) then
  755. p.left:=left.getcopy
  756. else
  757. p.left:=nil;
  758. getcopy:=p;
  759. end;
  760. procedure tunarynode.insertintolist(l : tnodelist);
  761. begin
  762. end;
  763. procedure tunarynode.printnodedata(var t:text);
  764. begin
  765. inherited printnodedata(t);
  766. printnode(t,left);
  767. end;
  768. procedure tunarynode.left_max;
  769. begin
  770. registersint:=left.registersint;
  771. registersfpu:=left.registersfpu;
  772. {$ifdef SUPPORT_MMX}
  773. registersmmx:=left.registersmmx;
  774. {$endif SUPPORT_MMX}
  775. end;
  776. procedure tunarynode.concattolist(l : tlinkedlist);
  777. begin
  778. left.parent:=self;
  779. left.concattolist(l);
  780. inherited concattolist(l);
  781. end;
  782. function tunarynode.ischild(p : tnode) : boolean;
  783. begin
  784. ischild:=p=left;
  785. end;
  786. {****************************************************************************
  787. TBINARYNODE
  788. ****************************************************************************}
  789. constructor tbinarynode.create(t:tnodetype;l,r : tnode);
  790. begin
  791. inherited create(t,l);
  792. right:=r
  793. end;
  794. constructor tbinarynode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  795. begin
  796. inherited ppuload(t,ppufile);
  797. right:=ppuloadnode(ppufile);
  798. end;
  799. destructor tbinarynode.destroy;
  800. begin
  801. right.free;
  802. inherited destroy;
  803. end;
  804. procedure tbinarynode.ppuwrite(ppufile:tcompilerppufile);
  805. begin
  806. inherited ppuwrite(ppufile);
  807. ppuwritenode(ppufile,right);
  808. end;
  809. procedure tbinarynode.buildderefimpl;
  810. begin
  811. inherited buildderefimpl;
  812. if assigned(right) then
  813. right.buildderefimpl;
  814. end;
  815. procedure tbinarynode.derefimpl;
  816. begin
  817. inherited derefimpl;
  818. if assigned(right) then
  819. right.derefimpl;
  820. end;
  821. procedure tbinarynode.derefnode;
  822. begin
  823. inherited derefnode;
  824. if assigned(right) then
  825. right.derefnode;
  826. end;
  827. procedure tbinarynode.concattolist(l : tlinkedlist);
  828. begin
  829. { we could change that depending on the number of }
  830. { required registers }
  831. left.parent:=self;
  832. left.concattolist(l);
  833. left.parent:=self;
  834. left.concattolist(l);
  835. inherited concattolist(l);
  836. end;
  837. function tbinarynode.ischild(p : tnode) : boolean;
  838. begin
  839. ischild:=(p=right);
  840. end;
  841. function tbinarynode.docompare(p : tnode) : boolean;
  842. begin
  843. docompare:=(inherited docompare(p) and
  844. ((right=nil) or right.isequal(tbinarynode(p).right))
  845. );
  846. end;
  847. function tbinarynode.getcopy : tnode;
  848. var
  849. p : tbinarynode;
  850. begin
  851. p:=tbinarynode(inherited getcopy);
  852. if assigned(right) then
  853. p.right:=right.getcopy
  854. else
  855. p.right:=nil;
  856. getcopy:=p;
  857. end;
  858. procedure tbinarynode.insertintolist(l : tnodelist);
  859. begin
  860. end;
  861. procedure tbinarynode.swapleftright;
  862. var
  863. swapp : tnode;
  864. begin
  865. swapp:=right;
  866. right:=left;
  867. left:=swapp;
  868. if nf_swaped in flags then
  869. exclude(flags,nf_swaped)
  870. else
  871. include(flags,nf_swaped);
  872. end;
  873. procedure tbinarynode.left_right_max;
  874. begin
  875. if assigned(left) then
  876. begin
  877. if assigned(right) then
  878. begin
  879. registersint:=max(left.registersint,right.registersint);
  880. registersfpu:=max(left.registersfpu,right.registersfpu);
  881. {$ifdef SUPPORT_MMX}
  882. registersmmx:=max(left.registersmmx,right.registersmmx);
  883. {$endif SUPPORT_MMX}
  884. end
  885. else
  886. begin
  887. registersint:=left.registersint;
  888. registersfpu:=left.registersfpu;
  889. {$ifdef SUPPORT_MMX}
  890. registersmmx:=left.registersmmx;
  891. {$endif SUPPORT_MMX}
  892. end;
  893. end;
  894. end;
  895. procedure tbinarynode.printnodedata(var t:text);
  896. begin
  897. inherited printnodedata(t);
  898. printnode(t,right);
  899. end;
  900. procedure tbinarynode.printnodelist(var t:text);
  901. var
  902. hp : tbinarynode;
  903. begin
  904. hp:=self;
  905. while assigned(hp) do
  906. begin
  907. write(t,printnodeindention,'(');
  908. printnodeindent;
  909. hp.printnodeinfo(t);
  910. printnode(t,hp.left);
  911. writeln(t);
  912. printnodeunindent;
  913. writeln(t,printnodeindention,')');
  914. hp:=tbinarynode(hp.right);
  915. end;
  916. end;
  917. {****************************************************************************
  918. TBINOPYNODE
  919. ****************************************************************************}
  920. constructor tbinopnode.create(t:tnodetype;l,r : tnode);
  921. begin
  922. inherited create(t,l,r);
  923. end;
  924. function tbinopnode.docompare(p : tnode) : boolean;
  925. begin
  926. docompare:=(inherited docompare(p)) or
  927. { if that's in the flags, is p then always a tbinopnode (?) (JM) }
  928. ((nf_swapable in flags) and
  929. left.isequal(tbinopnode(p).right) and
  930. right.isequal(tbinopnode(p).left));
  931. end;
  932. end.
  933. {
  934. $Log$
  935. Revision 1.94 2005-01-03 17:55:57 florian
  936. + first batch of patches to support tdef.getcopy fully
  937. Revision 1.93 2004/12/26 16:22:01 peter
  938. * fix lineinfo for with blocks
  939. Revision 1.92 2004/12/05 12:28:11 peter
  940. * procvar handling for tp procvar mode fixed
  941. * proc to procvar moved from addrnode to typeconvnode
  942. * inlininginfo is now allocated only for inline routines that
  943. can be inlined, introduced a new flag po_has_inlining_info
  944. Revision 1.91 2004/12/02 19:26:15 peter
  945. * disable pass2inline
  946. Revision 1.90 2004/11/02 12:55:16 peter
  947. * nf_internal flag for internal inserted typeconvs. This will
  948. supress the generation of warning/hints
  949. Revision 1.89 2004/11/01 17:15:47 peter
  950. * no checkpointer code for dynarr to openarr
  951. Revision 1.88 2004/10/31 21:45:03 peter
  952. * generic tlocation
  953. * move tlocation to cgutils
  954. Revision 1.87 2004/06/20 08:55:29 florian
  955. * logs truncated
  956. Revision 1.86 2004/06/16 20:07:09 florian
  957. * dwarf branch merged
  958. Revision 1.85 2004/05/24 20:39:41 florian
  959. * stricter handling of formal const parameters and IE fixed
  960. Revision 1.84 2004/05/23 18:28:41 peter
  961. * methodpointer is loaded into a temp when it was a calln
  962. Revision 1.83 2004/05/23 15:06:21 peter
  963. * implicit_finally flag must be set in pass1
  964. * add check whether the implicit frame is generated when expected
  965. Revision 1.82 2004/05/20 21:54:33 florian
  966. + <pointer> - <pointer> result is divided by the pointer element size now
  967. this is delphi compatible as well as resulting in the expected result for p1+(p2-p1)
  968. }