nadd.pas 74 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Florian Klaempfl
  4. Type checking and register allocation for add 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 nadd;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. node;
  23. type
  24. taddnode = class(tbinopnode)
  25. constructor create(tt : tnodetype;l,r : tnode);override;
  26. function pass_1 : tnode;override;
  27. function det_resulttype:tnode;override;
  28. {$ifdef state_tracking}
  29. function track_state_pass(exec_known:boolean):boolean;override;
  30. {$endif}
  31. protected
  32. { override the following if you want to implement }
  33. { parts explicitely in the code generator (JM) }
  34. function first_addstring: tnode; virtual;
  35. function first_addset: tnode; virtual;
  36. { only implements "muln" nodes, the rest always has to be done in }
  37. { the code generator for performance reasons (JM) }
  38. function first_add64bitint: tnode; virtual;
  39. { This routine calls internal runtime library helpers
  40. for all floating point arithmetic in the case
  41. where the emulation switches is on. Otherwise
  42. returns nil, and everything must be done in
  43. the code generation phase.
  44. }
  45. function first_addfloat : tnode; virtual;
  46. end;
  47. taddnodeclass = class of taddnode;
  48. var
  49. { caddnode is used to create nodes of the add type }
  50. { the virtual constructor allows to assign }
  51. { another class type to caddnode => processor }
  52. { specific node types can be created }
  53. caddnode : taddnodeclass;
  54. implementation
  55. uses
  56. globtype,systems,
  57. cutils,verbose,globals,widestr,
  58. symconst,symtype,symdef,symsym,symtable,defbase,
  59. cgbase,
  60. htypechk,pass_1,
  61. nmat,ncnv,ncon,nset,nopt,ncal,ninl,
  62. {$ifdef state_tracking}
  63. nstate,
  64. {$endif}
  65. cpubase,cpuinfo;
  66. {*****************************************************************************
  67. TADDNODE
  68. *****************************************************************************}
  69. {$ifdef fpc}
  70. {$maxfpuregisters 0}
  71. {$endif fpc}
  72. constructor taddnode.create(tt : tnodetype;l,r : tnode);
  73. begin
  74. inherited create(tt,l,r);
  75. end;
  76. function taddnode.det_resulttype:tnode;
  77. var
  78. hp,t : tnode;
  79. lt,rt : tnodetype;
  80. rd,ld : tdef;
  81. htype : ttype;
  82. ot : tnodetype;
  83. concatstrings : boolean;
  84. resultset : Tconstset;
  85. i : longint;
  86. b : boolean;
  87. s1,s2 : pchar;
  88. ws1,ws2 : pcompilerwidestring;
  89. l1,l2 : longint;
  90. rv,lv : tconstexprint;
  91. rvd,lvd : bestreal;
  92. {$ifdef state_tracking}
  93. factval : Tnode;
  94. change : boolean;
  95. {$endif}
  96. begin
  97. result:=nil;
  98. { first do the two subtrees }
  99. resulttypepass(left);
  100. resulttypepass(right);
  101. { both left and right need to be valid }
  102. set_varstate(left,true);
  103. set_varstate(right,true);
  104. if codegenerror then
  105. exit;
  106. { convert array constructors to sets, because there is no other operator
  107. possible for array constructors }
  108. if is_array_constructor(left.resulttype.def) then
  109. begin
  110. arrayconstructor_to_set(left);
  111. resulttypepass(left);
  112. end;
  113. if is_array_constructor(right.resulttype.def) then
  114. begin
  115. arrayconstructor_to_set(right);
  116. resulttypepass(right);
  117. end;
  118. { allow operator overloading }
  119. hp:=self;
  120. if isbinaryoverloaded(hp) then
  121. begin
  122. result:=hp;
  123. exit;
  124. end;
  125. { Kylix allows enum+ordconstn in an enum declaration (blocktype
  126. is bt_type), we need to do the conversion here before the
  127. constant folding }
  128. if (m_delphi in aktmodeswitches) and
  129. (blocktype=bt_type) then
  130. begin
  131. if (left.resulttype.def.deftype=enumdef) and
  132. (right.resulttype.def.deftype=orddef) then
  133. begin
  134. { insert explicit typecast to s32bit }
  135. left:=ctypeconvnode.create(left,s32bittype);
  136. left.toggleflag(nf_explizit);
  137. resulttypepass(left);
  138. end
  139. else
  140. if (left.resulttype.def.deftype=orddef) and
  141. (right.resulttype.def.deftype=enumdef) then
  142. begin
  143. { insert explicit typecast to s32bit }
  144. right:=ctypeconvnode.create(right,s32bittype);
  145. include(right.flags,nf_explizit);
  146. resulttypepass(right);
  147. end;
  148. end;
  149. { is one a real float, then both need to be floats, this
  150. need to be done before the constant folding so constant
  151. operation on a float and int are also handled }
  152. if (right.resulttype.def.deftype=floatdef) or (left.resulttype.def.deftype=floatdef) then
  153. begin
  154. inserttypeconv(right,pbestrealtype^);
  155. inserttypeconv(left,pbestrealtype^);
  156. end;
  157. { if one operand is a widechar or a widestring, both operands }
  158. { are converted to widestring. This must be done before constant }
  159. { folding to allow char+widechar etc. }
  160. if is_widestring(right.resulttype.def) or
  161. is_widestring(left.resulttype.def) or
  162. is_widechar(right.resulttype.def) or
  163. is_widechar(left.resulttype.def) then
  164. begin
  165. inserttypeconv(right,cwidestringtype);
  166. inserttypeconv(left,cwidestringtype);
  167. end;
  168. { load easier access variables }
  169. rd:=right.resulttype.def;
  170. ld:=left.resulttype.def;
  171. rt:=right.nodetype;
  172. lt:=left.nodetype;
  173. if (nodetype = slashn) and
  174. (((rt = ordconstn) and
  175. (tordconstnode(right).value = 0)) or
  176. ((rt = realconstn) and
  177. (trealconstnode(right).value_real = 0.0))) then
  178. begin
  179. Message(parser_e_division_by_zero);
  180. case rt of
  181. ordconstn:
  182. tordconstnode(right).value := 1;
  183. realconstn:
  184. trealconstnode(right).value_real := 1.0;
  185. end;
  186. end;
  187. { both are int constants }
  188. if (((is_constintnode(left) and is_constintnode(right)) or
  189. (is_constboolnode(left) and is_constboolnode(right) and
  190. (nodetype in [slashn,ltn,lten,gtn,gten,equaln,unequaln,andn,xorn,orn])))) or
  191. { support pointer arithmetics on constants (JM) }
  192. ((lt = pointerconstn) and is_constintnode(right) and
  193. (nodetype in [addn,subn])) or
  194. (((lt = pointerconstn) or (lt = niln)) and
  195. ((rt = pointerconstn) or (rt = niln)) and
  196. (nodetype in [ltn,lten,gtn,gten,equaln,unequaln,subn])) then
  197. begin
  198. { when comparing/substracting pointers, make sure they are }
  199. { of the same type (JM) }
  200. if (lt = pointerconstn) and (rt = pointerconstn) then
  201. begin
  202. if not(cs_extsyntax in aktmoduleswitches) and
  203. not(nodetype in [equaln,unequaln]) then
  204. CGMessage(type_e_mismatch)
  205. else
  206. if (nodetype <> subn) and
  207. is_voidpointer(rd) then
  208. inserttypeconv(right,left.resulttype)
  209. else if (nodetype <> subn) and
  210. is_voidpointer(ld) then
  211. inserttypeconv(left,right.resulttype)
  212. else if not(is_equal(ld,rd)) then
  213. CGMessage(type_e_mismatch);
  214. end
  215. else if (lt=ordconstn) and (rt=ordconstn) then
  216. begin
  217. { make left const type the biggest (u32bit is bigger than
  218. s32bit for or,and,xor) }
  219. if (rd.size>ld.size) or
  220. ((torddef(rd).typ=u32bit) and
  221. (torddef(ld).typ=s32bit) and
  222. (nodetype in [orn,andn,xorn])) then
  223. inserttypeconv(left,right.resulttype);
  224. end;
  225. { load values }
  226. case lt of
  227. ordconstn:
  228. lv:=tordconstnode(left).value;
  229. pointerconstn:
  230. lv:=tpointerconstnode(left).value;
  231. niln:
  232. lv:=0;
  233. else
  234. internalerror(2002080202);
  235. end;
  236. case rt of
  237. ordconstn:
  238. rv:=tordconstnode(right).value;
  239. pointerconstn:
  240. rv:=tpointerconstnode(right).value;
  241. niln:
  242. rv:=0;
  243. else
  244. internalerror(2002080203);
  245. end;
  246. if (lt = pointerconstn) and
  247. (rt <> pointerconstn) then
  248. rv := rv * tpointerdef(left.resulttype.def).pointertype.def.size;
  249. if (rt = pointerconstn) and
  250. (lt <> pointerconstn) then
  251. lv := lv * tpointerdef(right.resulttype.def).pointertype.def.size;
  252. case nodetype of
  253. addn :
  254. if (lt <> pointerconstn) then
  255. t := genintconstnode(lv+rv)
  256. else
  257. t := cpointerconstnode.create(lv+rv,left.resulttype);
  258. subn :
  259. if (lt <> pointerconstn) or (rt = pointerconstn) then
  260. t := genintconstnode(lv-rv)
  261. else
  262. t := cpointerconstnode.create(lv-rv,left.resulttype);
  263. muln :
  264. t:=genintconstnode(lv*rv);
  265. xorn :
  266. t:=cordconstnode.create(lv xor rv,left.resulttype,true);
  267. orn :
  268. t:=cordconstnode.create(lv or rv,left.resulttype,true);
  269. andn :
  270. t:=cordconstnode.create(lv and rv,left.resulttype,true);
  271. ltn :
  272. t:=cordconstnode.create(ord(lv<rv),booltype,true);
  273. lten :
  274. t:=cordconstnode.create(ord(lv<=rv),booltype,true);
  275. gtn :
  276. t:=cordconstnode.create(ord(lv>rv),booltype,true);
  277. gten :
  278. t:=cordconstnode.create(ord(lv>=rv),booltype,true);
  279. equaln :
  280. t:=cordconstnode.create(ord(lv=rv),booltype,true);
  281. unequaln :
  282. t:=cordconstnode.create(ord(lv<>rv),booltype,true);
  283. slashn :
  284. begin
  285. { int/int becomes a real }
  286. rvd:=rv;
  287. lvd:=lv;
  288. t:=crealconstnode.create(lvd/rvd,pbestrealtype^);
  289. end;
  290. else
  291. CGMessage(type_e_mismatch);
  292. end;
  293. result:=t;
  294. exit;
  295. end;
  296. { both real constants ? }
  297. if (lt=realconstn) and (rt=realconstn) then
  298. begin
  299. lvd:=trealconstnode(left).value_real;
  300. rvd:=trealconstnode(right).value_real;
  301. case nodetype of
  302. addn :
  303. t:=crealconstnode.create(lvd+rvd,pbestrealtype^);
  304. subn :
  305. t:=crealconstnode.create(lvd-rvd,pbestrealtype^);
  306. muln :
  307. t:=crealconstnode.create(lvd*rvd,pbestrealtype^);
  308. starstarn,
  309. caretn :
  310. begin
  311. if lvd<0 then
  312. begin
  313. Message(parser_e_invalid_float_operation);
  314. t:=crealconstnode.create(0,pbestrealtype^);
  315. end
  316. else if lvd=0 then
  317. t:=crealconstnode.create(1.0,pbestrealtype^)
  318. else
  319. t:=crealconstnode.create(exp(ln(lvd)*rvd),pbestrealtype^);
  320. end;
  321. slashn :
  322. begin
  323. t:=crealconstnode.create(lvd/rvd,pbestrealtype^);
  324. end;
  325. ltn :
  326. t:=cordconstnode.create(ord(lvd<rvd),booltype,true);
  327. lten :
  328. t:=cordconstnode.create(ord(lvd<=rvd),booltype,true);
  329. gtn :
  330. t:=cordconstnode.create(ord(lvd>rvd),booltype,true);
  331. gten :
  332. t:=cordconstnode.create(ord(lvd>=rvd),booltype,true);
  333. equaln :
  334. t:=cordconstnode.create(ord(lvd=rvd),booltype,true);
  335. unequaln :
  336. t:=cordconstnode.create(ord(lvd<>rvd),booltype,true);
  337. else
  338. CGMessage(type_e_mismatch);
  339. end;
  340. result:=t;
  341. exit;
  342. end;
  343. { first, we handle widestrings, so we can check later for }
  344. { stringconstn only }
  345. { widechars are converted above to widestrings too }
  346. { this isn't veryy efficient, but I don't think }
  347. { that it does matter that much (FK) }
  348. if (lt=stringconstn) and (rt=stringconstn) and
  349. (tstringconstnode(left).st_type=st_widestring) and
  350. (tstringconstnode(right).st_type=st_widestring) then
  351. begin
  352. initwidestring(ws1);
  353. initwidestring(ws2);
  354. copywidestring(pcompilerwidestring(tstringconstnode(left).value_str),ws1);
  355. copywidestring(pcompilerwidestring(tstringconstnode(right).value_str),ws2);
  356. case nodetype of
  357. addn :
  358. begin
  359. concatwidestrings(ws1,ws2);
  360. t:=cstringconstnode.createwstr(ws1);
  361. end;
  362. ltn :
  363. t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<0),booltype,true);
  364. lten :
  365. t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<=0),booltype,true);
  366. gtn :
  367. t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)>0),booltype,true);
  368. gten :
  369. t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)>=0),booltype,true);
  370. equaln :
  371. t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)=0),booltype,true);
  372. unequaln :
  373. t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<>0),booltype,true);
  374. end;
  375. donewidestring(ws1);
  376. donewidestring(ws2);
  377. result:=t;
  378. exit;
  379. end;
  380. { concating strings ? }
  381. concatstrings:=false;
  382. s1:=nil;
  383. s2:=nil;
  384. if (lt=ordconstn) and (rt=ordconstn) and
  385. is_char(ld) and is_char(rd) then
  386. begin
  387. s1:=strpnew(char(byte(tordconstnode(left).value)));
  388. s2:=strpnew(char(byte(tordconstnode(right).value)));
  389. l1:=1;
  390. l2:=1;
  391. concatstrings:=true;
  392. end
  393. else
  394. if (lt=stringconstn) and (rt=ordconstn) and is_char(rd) then
  395. begin
  396. s1:=tstringconstnode(left).getpcharcopy;
  397. l1:=tstringconstnode(left).len;
  398. s2:=strpnew(char(byte(tordconstnode(right).value)));
  399. l2:=1;
  400. concatstrings:=true;
  401. end
  402. else
  403. if (lt=ordconstn) and (rt=stringconstn) and is_char(ld) then
  404. begin
  405. s1:=strpnew(char(byte(tordconstnode(left).value)));
  406. l1:=1;
  407. s2:=tstringconstnode(right).getpcharcopy;
  408. l2:=tstringconstnode(right).len;
  409. concatstrings:=true;
  410. end
  411. else if (lt=stringconstn) and (rt=stringconstn) then
  412. begin
  413. s1:=tstringconstnode(left).getpcharcopy;
  414. l1:=tstringconstnode(left).len;
  415. s2:=tstringconstnode(right).getpcharcopy;
  416. l2:=tstringconstnode(right).len;
  417. concatstrings:=true;
  418. end;
  419. if concatstrings then
  420. begin
  421. case nodetype of
  422. addn :
  423. t:=cstringconstnode.createpchar(concatansistrings(s1,s2,l1,l2),l1+l2);
  424. ltn :
  425. t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<0),booltype,true);
  426. lten :
  427. t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<=0),booltype,true);
  428. gtn :
  429. t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)>0),booltype,true);
  430. gten :
  431. t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)>=0),booltype,true);
  432. equaln :
  433. t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)=0),booltype,true);
  434. unequaln :
  435. t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<>0),booltype,true);
  436. end;
  437. ansistringdispose(s1,l1);
  438. ansistringdispose(s2,l2);
  439. result:=t;
  440. exit;
  441. end;
  442. { set constant evaluation }
  443. if (right.nodetype=setconstn) and
  444. not assigned(tsetconstnode(right).left) and
  445. (left.nodetype=setconstn) and
  446. not assigned(tsetconstnode(left).left) then
  447. begin
  448. { check if size adjusting is needed, only for left
  449. to right as the other way is checked in the typeconv }
  450. if (tsetdef(right.resulttype.def).settype=smallset) and
  451. (tsetdef(left.resulttype.def).settype<>smallset) then
  452. tsetdef(right.resulttype.def).changesettype(normset);
  453. { check base types }
  454. inserttypeconv(left,right.resulttype);
  455. if codegenerror then
  456. begin
  457. { recover by only returning the left part }
  458. result:=left;
  459. left:=nil;
  460. exit;
  461. end;
  462. {$ifdef oldset}
  463. case nodetype of
  464. addn :
  465. begin
  466. for i:=0 to 31 do
  467. resultset[i]:=tsetconstnode(right).value_set^[i] or tsetconstnode(left).value_set^[i];
  468. t:=csetconstnode.create(@resultset,left.resulttype);
  469. end;
  470. muln :
  471. begin
  472. for i:=0 to 31 do
  473. resultset[i]:=tsetconstnode(right).value_set^[i] and tsetconstnode(left).value_set^[i];
  474. t:=csetconstnode.create(@resultset,left.resulttype);
  475. end;
  476. subn :
  477. begin
  478. for i:=0 to 31 do
  479. resultset[i]:=tsetconstnode(left).value_set^[i] and not(tsetconstnode(right).value_set^[i]);
  480. t:=csetconstnode.create(@resultset,left.resulttype);
  481. end;
  482. symdifn :
  483. begin
  484. for i:=0 to 31 do
  485. resultset[i]:=tsetconstnode(left).value_set^[i] xor tsetconstnode(right).value_set^[i];
  486. t:=csetconstnode.create(@resultset,left.resulttype);
  487. end;
  488. unequaln :
  489. begin
  490. b:=true;
  491. for i:=0 to 31 do
  492. if tsetconstnode(right).value_set^[i]=tsetconstnode(left).value_set^[i] then
  493. begin
  494. b:=false;
  495. break;
  496. end;
  497. t:=cordconstnode.create(ord(b),booltype,true);
  498. end;
  499. equaln :
  500. begin
  501. b:=true;
  502. for i:=0 to 31 do
  503. if tsetconstnode(right).value_set^[i]<>tsetconstnode(left).value_set^[i] then
  504. begin
  505. b:=false;
  506. break;
  507. end;
  508. t:=cordconstnode.create(ord(b),booltype,true);
  509. end;
  510. lten :
  511. begin
  512. b := true;
  513. for i := 0 to 31 Do
  514. if (tsetconstnode(right).value_set^[i] And tsetconstnode(left).value_set^[i]) <>
  515. tsetconstnode(left).value_set^[i] Then
  516. begin
  517. b := false;
  518. break
  519. end;
  520. t := cordconstnode.create(ord(b),booltype,true);
  521. end;
  522. gten :
  523. begin
  524. b := true;
  525. for i := 0 to 31 Do
  526. If (tsetconstnode(left).value_set^[i] And tsetconstnode(right).value_set^[i]) <>
  527. tsetconstnode(right).value_set^[i] Then
  528. begin
  529. b := false;
  530. break
  531. end;
  532. t := cordconstnode.create(ord(b),booltype,true);
  533. end;
  534. end;
  535. {$else}
  536. case nodetype of
  537. addn :
  538. begin
  539. resultset:=tsetconstnode(right).value_set^ + tsetconstnode(left).value_set^;
  540. t:=csetconstnode.create(@resultset,left.resulttype);
  541. end;
  542. muln :
  543. begin
  544. resultset:=tsetconstnode(right).value_set^ * tsetconstnode(left).value_set^;
  545. t:=csetconstnode.create(@resultset,left.resulttype);
  546. end;
  547. subn :
  548. begin
  549. resultset:=tsetconstnode(left).value_set^ - tsetconstnode(right).value_set^;
  550. t:=csetconstnode.create(@resultset,left.resulttype);
  551. end;
  552. symdifn :
  553. begin
  554. resultset:=tsetconstnode(right).value_set^ >< tsetconstnode(left).value_set^;
  555. t:=csetconstnode.create(@resultset,left.resulttype);
  556. end;
  557. unequaln :
  558. begin
  559. b:=tsetconstnode(right).value_set^ <> tsetconstnode(left).value_set^;
  560. t:=cordconstnode.create(byte(b),booltype,true);
  561. end;
  562. equaln :
  563. begin
  564. b:=tsetconstnode(right).value_set^ = tsetconstnode(left).value_set^;
  565. t:=cordconstnode.create(byte(b),booltype,true);
  566. end;
  567. lten :
  568. begin
  569. b:=tsetconstnode(left).value_set^ <= tsetconstnode(right).value_set^;
  570. t:=cordconstnode.create(byte(b),booltype,true);
  571. end;
  572. gten :
  573. begin
  574. b:=tsetconstnode(left).value_set^ >= tsetconstnode(right).value_set^;
  575. t:=cordconstnode.create(byte(b),booltype,true);
  576. end;
  577. end;
  578. {$endif}
  579. result:=t;
  580. exit;
  581. end;
  582. { but an int/int gives real/real! }
  583. if nodetype=slashn then
  584. begin
  585. CGMessage(type_h_use_div_for_int);
  586. inserttypeconv(right,pbestrealtype^);
  587. inserttypeconv(left,pbestrealtype^);
  588. end
  589. { if both are orddefs then check sub types }
  590. else if (ld.deftype=orddef) and (rd.deftype=orddef) then
  591. begin
  592. { optimize multiplacation by a power of 2 }
  593. if not(cs_check_overflow in aktlocalswitches) and
  594. (nodetype = muln) and
  595. (((left.nodetype = ordconstn) and
  596. ispowerof2(tordconstnode(left).value,i)) or
  597. ((right.nodetype = ordconstn) and
  598. ispowerof2(tordconstnode(right).value,i))) then
  599. begin
  600. if left.nodetype = ordconstn then
  601. begin
  602. tordconstnode(left).value := i;
  603. result := cshlshrnode.create(shln,right,left);
  604. end
  605. else
  606. begin
  607. tordconstnode(right).value := i;
  608. result := cshlshrnode.create(shln,left,right);
  609. end;
  610. left := nil;
  611. right := nil;
  612. exit;
  613. end;
  614. { 2 booleans? Make them equal to the largest boolean }
  615. if is_boolean(ld) and is_boolean(rd) then
  616. begin
  617. if torddef(left.resulttype.def).size>torddef(right.resulttype.def).size then
  618. begin
  619. right:=ctypeconvnode.create(right,left.resulttype);
  620. ttypeconvnode(right).convtype:=tc_bool_2_int;
  621. right.toggleflag(nf_explizit);
  622. resulttypepass(right);
  623. end
  624. else if torddef(left.resulttype.def).size<torddef(right.resulttype.def).size then
  625. begin
  626. left:=ctypeconvnode.create(left,right.resulttype);
  627. ttypeconvnode(left).convtype:=tc_bool_2_int;
  628. left.toggleflag(nf_explizit);
  629. resulttypepass(left);
  630. end;
  631. case nodetype of
  632. xorn,
  633. ltn,
  634. lten,
  635. gtn,
  636. gten,
  637. andn,
  638. orn:
  639. begin
  640. end;
  641. unequaln,
  642. equaln:
  643. begin
  644. if not(cs_full_boolean_eval in aktlocalswitches) then
  645. begin
  646. { Remove any compares with constants }
  647. if (left.nodetype=ordconstn) then
  648. begin
  649. hp:=right;
  650. b:=(tordconstnode(left).value<>0);
  651. ot:=nodetype;
  652. left.free;
  653. left:=nil;
  654. right:=nil;
  655. if (not(b) and (ot=equaln)) or
  656. (b and (ot=unequaln)) then
  657. begin
  658. hp:=cnotnode.create(hp);
  659. end;
  660. result:=hp;
  661. exit;
  662. end;
  663. if (right.nodetype=ordconstn) then
  664. begin
  665. hp:=left;
  666. b:=(tordconstnode(right).value<>0);
  667. ot:=nodetype;
  668. right.free;
  669. right:=nil;
  670. left:=nil;
  671. if (not(b) and (ot=equaln)) or
  672. (b and (ot=unequaln)) then
  673. begin
  674. hp:=cnotnode.create(hp);
  675. end;
  676. result:=hp;
  677. exit;
  678. end;
  679. end;
  680. end;
  681. else
  682. CGMessage(type_e_mismatch);
  683. end;
  684. end
  685. { Both are chars? }
  686. else if is_char(rd) and is_char(ld) then
  687. begin
  688. if nodetype=addn then
  689. begin
  690. resulttype:=cshortstringtype;
  691. if not(is_constcharnode(left) and is_constcharnode(right)) then
  692. begin
  693. inserttypeconv(left,cshortstringtype);
  694. hp := genaddsstringcharoptnode(self);
  695. result := hp;
  696. exit;
  697. end;
  698. end;
  699. end
  700. { is there a signed 64 bit type ? }
  701. else if ((torddef(rd).typ=s64bit) or (torddef(ld).typ=s64bit)) then
  702. begin
  703. if (torddef(ld).typ<>s64bit) then
  704. inserttypeconv(left,cs64bittype);
  705. if (torddef(rd).typ<>s64bit) then
  706. inserttypeconv(right,cs64bittype);
  707. end
  708. { is there a unsigned 64 bit type ? }
  709. else if ((torddef(rd).typ=u64bit) or (torddef(ld).typ=u64bit)) then
  710. begin
  711. if (torddef(ld).typ<>u64bit) then
  712. inserttypeconv(left,cu64bittype);
  713. if (torddef(rd).typ<>u64bit) then
  714. inserttypeconv(right,cu64bittype);
  715. end
  716. { is there a cardinal? }
  717. else if ((torddef(rd).typ=u32bit) or (torddef(ld).typ=u32bit)) then
  718. begin
  719. if is_signed(ld) and
  720. { then rd = u32bit }
  721. { convert positive constants to u32bit }
  722. not(is_constintnode(left) and
  723. (tordconstnode(left).value >= 0)) and
  724. { range/overflow checking on mixed signed/cardinal expressions }
  725. { is only possible if you convert everything to 64bit (JM) }
  726. ((aktlocalswitches * [cs_check_overflow,cs_check_range] <> []) and
  727. (nodetype in [addn,subn,muln])) then
  728. begin
  729. { perform the operation in 64bit }
  730. CGMessage(type_w_mixed_signed_unsigned);
  731. inserttypeconv(left,cs64bittype);
  732. inserttypeconv(right,cs64bittype);
  733. end
  734. else
  735. begin
  736. { and,or,xor work on bit patterns and don't care
  737. about the sign }
  738. if nodetype in [andn,orn,xorn] then
  739. inserttypeconv_explicit(left,u32bittype)
  740. else
  741. begin
  742. if is_signed(ld) and
  743. not(is_constintnode(left) and
  744. (tordconstnode(left).value >= 0)) and
  745. (cs_check_range in aktlocalswitches) then
  746. CGMessage(type_w_mixed_signed_unsigned2);
  747. inserttypeconv(left,u32bittype);
  748. end;
  749. if is_signed(rd) and
  750. { then ld = u32bit }
  751. { convert positive constants to u32bit }
  752. not(is_constintnode(right) and
  753. (tordconstnode(right).value >= 0)) and
  754. ((aktlocalswitches * [cs_check_overflow,cs_check_range] <> []) and
  755. (nodetype in [addn,subn,muln])) then
  756. begin
  757. { perform the operation in 64bit }
  758. CGMessage(type_w_mixed_signed_unsigned);
  759. inserttypeconv(left,cs64bittype);
  760. inserttypeconv(right,cs64bittype);
  761. end
  762. else
  763. begin
  764. { and,or,xor work on bit patterns and don't care
  765. about the sign }
  766. if nodetype in [andn,orn,xorn] then
  767. inserttypeconv_explicit(left,u32bittype)
  768. else
  769. begin
  770. if is_signed(rd) and
  771. not(is_constintnode(right) and
  772. (tordconstnode(right).value >= 0)) and
  773. (cs_check_range in aktlocalswitches) then
  774. CGMessage(type_w_mixed_signed_unsigned2);
  775. inserttypeconv(right,u32bittype);
  776. end;
  777. end;
  778. end;
  779. end
  780. { generic ord conversion is s32bit }
  781. else
  782. begin
  783. inserttypeconv(right,s32bittype);
  784. inserttypeconv(left,s32bittype);
  785. end;
  786. end
  787. { if both are floatdefs, conversion is already done before constant folding }
  788. else if (ld.deftype=floatdef) then
  789. begin
  790. { already converted }
  791. end
  792. { left side a setdef, must be before string processing,
  793. else array constructor can be seen as array of char (PFV) }
  794. else if (ld.deftype=setdef) then
  795. begin
  796. { trying to add a set element? }
  797. if (nodetype=addn) and (rd.deftype<>setdef) then
  798. begin
  799. if (rt=setelementn) then
  800. begin
  801. if not(is_equal(tsetdef(ld).elementtype.def,rd)) then
  802. CGMessage(type_e_set_element_are_not_comp);
  803. end
  804. else
  805. CGMessage(type_e_mismatch)
  806. end
  807. else
  808. begin
  809. if not(nodetype in [addn,subn,symdifn,muln,equaln,unequaln,lten,gten]) then
  810. CGMessage(type_e_set_operation_unknown);
  811. { right def must be a also be set }
  812. if (rd.deftype<>setdef) or not(is_equal(rd,ld)) then
  813. CGMessage(type_e_set_element_are_not_comp);
  814. end;
  815. { ranges require normsets }
  816. if (tsetdef(ld).settype=smallset) and
  817. (rt=setelementn) and
  818. assigned(tsetelementnode(right).right) then
  819. begin
  820. { generate a temporary normset def, it'll be destroyed
  821. when the symtable is unloaded }
  822. htype.setdef(tsetdef.create(tsetdef(ld).elementtype,255));
  823. inserttypeconv(left,htype);
  824. end;
  825. { if the right side is also a setdef then the settype must
  826. be the same as the left setdef }
  827. if (rd.deftype=setdef) and
  828. (tsetdef(ld).settype<>tsetdef(rd).settype) then
  829. inserttypeconv(right,left.resulttype);
  830. end
  831. { compare pchar to char arrays by addresses like BP/Delphi }
  832. else if (is_pchar(ld) and is_chararray(rd)) or
  833. (is_pchar(rd) and is_chararray(ld)) then
  834. begin
  835. if is_chararray(rd) then
  836. inserttypeconv(right,left.resulttype)
  837. else
  838. inserttypeconv(left,right.resulttype);
  839. end
  840. { is one of the operands a string?,
  841. chararrays are also handled as strings (after conversion), also take
  842. care of chararray+chararray and chararray+char }
  843. else if (rd.deftype=stringdef) or (ld.deftype=stringdef) or
  844. ((is_chararray(rd) or is_char(rd)) and
  845. (is_chararray(ld) or is_char(ld))) then
  846. begin
  847. if is_widestring(rd) or is_widestring(ld) then
  848. begin
  849. if not(is_widestring(rd)) then
  850. inserttypeconv(right,cwidestringtype);
  851. if not(is_widestring(ld)) then
  852. inserttypeconv(left,cwidestringtype);
  853. end
  854. else if is_ansistring(rd) or is_ansistring(ld) then
  855. begin
  856. if not(is_ansistring(rd)) then
  857. inserttypeconv(right,cansistringtype);
  858. if not(is_ansistring(ld)) then
  859. inserttypeconv(left,cansistringtype);
  860. end
  861. else if is_longstring(rd) or is_longstring(ld) then
  862. begin
  863. if not(is_longstring(rd)) then
  864. inserttypeconv(right,clongstringtype);
  865. if not(is_longstring(ld)) then
  866. inserttypeconv(left,clongstringtype);
  867. location.loc:=LOC_CREFERENCE;
  868. end
  869. else
  870. begin
  871. if not(is_shortstring(ld)) then
  872. inserttypeconv(left,cshortstringtype);
  873. { don't convert char, that can be handled by the optimized node }
  874. if not(is_shortstring(rd) or is_char(rd)) then
  875. inserttypeconv(right,cshortstringtype);
  876. end;
  877. end
  878. { pointer comparision and subtraction }
  879. else if (rd.deftype=pointerdef) and (ld.deftype=pointerdef) then
  880. begin
  881. case nodetype of
  882. equaln,unequaln :
  883. begin
  884. if is_voidpointer(right.resulttype.def) then
  885. inserttypeconv(right,left.resulttype)
  886. else if is_voidpointer(left.resulttype.def) then
  887. inserttypeconv(left,right.resulttype)
  888. else if not(is_equal(ld,rd)) then
  889. CGMessage(type_e_mismatch);
  890. end;
  891. ltn,lten,gtn,gten:
  892. begin
  893. if (cs_extsyntax in aktmoduleswitches) then
  894. begin
  895. if is_voidpointer(right.resulttype.def) then
  896. inserttypeconv(right,left.resulttype)
  897. else if is_voidpointer(left.resulttype.def) then
  898. inserttypeconv(left,right.resulttype)
  899. else if not(is_equal(ld,rd)) then
  900. CGMessage(type_e_mismatch);
  901. end
  902. else
  903. CGMessage(type_e_mismatch);
  904. end;
  905. subn:
  906. begin
  907. if (cs_extsyntax in aktmoduleswitches) then
  908. begin
  909. if is_voidpointer(right.resulttype.def) then
  910. inserttypeconv(right,left.resulttype)
  911. else if is_voidpointer(left.resulttype.def) then
  912. inserttypeconv(left,right.resulttype)
  913. else if not(is_equal(ld,rd)) then
  914. CGMessage(type_e_mismatch);
  915. end
  916. else
  917. CGMessage(type_e_mismatch);
  918. resulttype:=s32bittype;
  919. exit;
  920. end;
  921. addn:
  922. begin
  923. if (cs_extsyntax in aktmoduleswitches) then
  924. begin
  925. if is_voidpointer(right.resulttype.def) then
  926. inserttypeconv(right,left.resulttype)
  927. else if is_voidpointer(left.resulttype.def) then
  928. inserttypeconv(left,right.resulttype)
  929. else if not(is_equal(ld,rd)) then
  930. CGMessage(type_e_mismatch);
  931. end
  932. else
  933. CGMessage(type_e_mismatch);
  934. resulttype:=s32bittype;
  935. exit;
  936. end;
  937. else
  938. CGMessage(type_e_mismatch);
  939. end;
  940. end
  941. { class or interface equation }
  942. else if is_class_or_interface(rd) or is_class_or_interface(ld) then
  943. begin
  944. if is_class_or_interface(rd) and is_class_or_interface(ld) then
  945. begin
  946. if tobjectdef(rd).is_related(tobjectdef(ld)) then
  947. inserttypeconv(right,left.resulttype)
  948. else
  949. inserttypeconv(left,right.resulttype);
  950. end
  951. else if is_class_or_interface(rd) then
  952. inserttypeconv(left,right.resulttype)
  953. else
  954. inserttypeconv(right,left.resulttype);
  955. if not(nodetype in [equaln,unequaln]) then
  956. CGMessage(type_e_mismatch);
  957. end
  958. else if (rd.deftype=classrefdef) and (ld.deftype=classrefdef) then
  959. begin
  960. if tobjectdef(tclassrefdef(rd).pointertype.def).is_related(
  961. tobjectdef(tclassrefdef(ld).pointertype.def)) then
  962. inserttypeconv(right,left.resulttype)
  963. else
  964. inserttypeconv(left,right.resulttype);
  965. if not(nodetype in [equaln,unequaln]) then
  966. CGMessage(type_e_mismatch);
  967. end
  968. { allows comperasion with nil pointer }
  969. else if is_class_or_interface(rd) or (rd.deftype=classrefdef) then
  970. begin
  971. inserttypeconv(left,right.resulttype);
  972. if not(nodetype in [equaln,unequaln]) then
  973. CGMessage(type_e_mismatch);
  974. end
  975. else if is_class_or_interface(ld) or (ld.deftype=classrefdef) then
  976. begin
  977. inserttypeconv(right,left.resulttype);
  978. if not(nodetype in [equaln,unequaln]) then
  979. CGMessage(type_e_mismatch);
  980. end
  981. { support procvar=nil,procvar<>nil }
  982. else if ((ld.deftype=procvardef) and (rt=niln)) or
  983. ((rd.deftype=procvardef) and (lt=niln)) then
  984. begin
  985. if not(nodetype in [equaln,unequaln]) then
  986. CGMessage(type_e_mismatch);
  987. end
  988. {$ifdef SUPPORT_MMX}
  989. { mmx support, this must be before the zero based array
  990. check }
  991. else if (cs_mmx in aktlocalswitches) and
  992. is_mmx_able_array(ld) and
  993. is_mmx_able_array(rd) and
  994. is_equal(ld,rd) then
  995. begin
  996. case nodetype of
  997. addn,subn,xorn,orn,andn:
  998. ;
  999. { mul is a little bit restricted }
  1000. muln:
  1001. if not(mmx_type(ld) in [mmxu16bit,mmxs16bit,mmxfixed16]) then
  1002. CGMessage(type_e_mismatch);
  1003. else
  1004. CGMessage(type_e_mismatch);
  1005. end;
  1006. end
  1007. {$endif SUPPORT_MMX}
  1008. { this is a little bit dangerous, also the left type }
  1009. { pointer to should be checked! This broke the mmx support }
  1010. else if (rd.deftype=pointerdef) or is_zero_based_array(rd) then
  1011. begin
  1012. if is_zero_based_array(rd) then
  1013. begin
  1014. resulttype.setdef(tpointerdef.create(tarraydef(rd).elementtype));
  1015. inserttypeconv(right,resulttype);
  1016. end;
  1017. inserttypeconv(left,s32bittype);
  1018. if nodetype=addn then
  1019. begin
  1020. if not(cs_extsyntax in aktmoduleswitches) or
  1021. (not(is_pchar(ld)) and not(m_add_pointer in aktmodeswitches)) then
  1022. CGMessage(type_e_mismatch);
  1023. if (rd.deftype=pointerdef) and
  1024. (tpointerdef(rd).pointertype.def.size>1) then
  1025. left:=caddnode.create(muln,left,
  1026. cordconstnode.create(tpointerdef(rd).pointertype.def.size,s32bittype,true));
  1027. end
  1028. else
  1029. CGMessage(type_e_mismatch);
  1030. end
  1031. else if (ld.deftype=pointerdef) or is_zero_based_array(ld) then
  1032. begin
  1033. if is_zero_based_array(ld) then
  1034. begin
  1035. resulttype.setdef(tpointerdef.create(tarraydef(ld).elementtype));
  1036. inserttypeconv(left,resulttype);
  1037. end;
  1038. inserttypeconv(right,s32bittype);
  1039. if nodetype in [addn,subn] then
  1040. begin
  1041. if not(cs_extsyntax in aktmoduleswitches) or
  1042. (not(is_pchar(ld)) and not(m_add_pointer in aktmodeswitches)) then
  1043. CGMessage(type_e_mismatch);
  1044. if (ld.deftype=pointerdef) and
  1045. (tpointerdef(ld).pointertype.def.size>1) then
  1046. right:=caddnode.create(muln,right,
  1047. cordconstnode.create(tpointerdef(ld).pointertype.def.size,s32bittype,true));
  1048. end
  1049. else
  1050. CGMessage(type_e_mismatch);
  1051. end
  1052. else if (rd.deftype=procvardef) and (ld.deftype=procvardef) and is_equal(rd,ld) then
  1053. begin
  1054. if not (nodetype in [equaln,unequaln]) then
  1055. CGMessage(type_e_mismatch);
  1056. end
  1057. { enums }
  1058. else if (ld.deftype=enumdef) and (rd.deftype=enumdef) then
  1059. begin
  1060. if not(is_equal(ld,rd)) then
  1061. inserttypeconv(right,left.resulttype);
  1062. if not(nodetype in [equaln,unequaln,ltn,lten,gtn,gten]) then
  1063. CGMessage(type_e_mismatch);
  1064. end
  1065. { generic conversion, this is for error recovery }
  1066. else
  1067. begin
  1068. inserttypeconv(left,s32bittype);
  1069. inserttypeconv(right,s32bittype);
  1070. end;
  1071. { set resulttype if not already done }
  1072. if not assigned(resulttype.def) then
  1073. begin
  1074. case nodetype of
  1075. ltn,lten,gtn,gten,equaln,unequaln :
  1076. resulttype:=booltype;
  1077. slashn :
  1078. resulttype:=pbestrealtype^;
  1079. addn:
  1080. begin
  1081. { for strings, return is always a 255 char string }
  1082. if is_shortstring(left.resulttype.def) then
  1083. resulttype:=cshortstringtype
  1084. else
  1085. resulttype:=left.resulttype;
  1086. end;
  1087. else
  1088. resulttype:=left.resulttype;
  1089. end;
  1090. end;
  1091. end;
  1092. function taddnode.first_addstring: tnode;
  1093. var
  1094. p: tnode;
  1095. begin
  1096. { when we get here, we are sure that both the left and the right }
  1097. { node are both strings of the same stringtype (JM) }
  1098. case nodetype of
  1099. addn:
  1100. begin
  1101. { note: if you implemented an fpc_shortstr_concat similar to the }
  1102. { one in i386.inc, you have to override first_addstring like in }
  1103. { ti386addnode.first_string and implement the shortstring concat }
  1104. { manually! The generic routine is different from the i386 one (JM) }
  1105. { create the call to the concat routine both strings as arguments }
  1106. result := ccallnode.createintern('fpc_'+
  1107. tstringdef(resulttype.def).stringtypname+'_concat',
  1108. ccallparanode.create(right,ccallparanode.create(left,nil)));
  1109. { we reused the arguments }
  1110. left := nil;
  1111. right := nil;
  1112. firstpass(result);
  1113. end;
  1114. ltn,lten,gtn,gten,equaln,unequaln :
  1115. begin
  1116. { generate better code for s='' and s<>'' }
  1117. if (nodetype in [equaln,unequaln]) and
  1118. (((left.nodetype=stringconstn) and (str_length(left)=0)) or
  1119. ((right.nodetype=stringconstn) and (str_length(right)=0))) then
  1120. begin
  1121. { switch so that the constant is always on the right }
  1122. if left.nodetype = stringconstn then
  1123. begin
  1124. p := left;
  1125. left := right;
  1126. right := p;
  1127. end;
  1128. if is_shortstring(left.resulttype.def) then
  1129. { compare the length with 0 }
  1130. result := caddnode.create(nodetype,
  1131. cinlinenode.create(in_length_x,false,left),
  1132. cordconstnode.create(0,s32bittype,false))
  1133. else
  1134. begin
  1135. { compare the pointer with nil (for ansistrings etc), }
  1136. { faster than getting the length (JM) }
  1137. result:= caddnode.create(nodetype,
  1138. ctypeconvnode.create(left,voidpointertype),
  1139. cpointerconstnode.create(0,voidpointertype));
  1140. taddnode(result).left.toggleflag(nf_explizit);
  1141. end;
  1142. { left is reused }
  1143. left := nil;
  1144. { right isn't }
  1145. right.free;
  1146. right := nil;
  1147. firstpass(result);
  1148. exit;
  1149. end;
  1150. { no string constant -> call compare routine }
  1151. result := ccallnode.createintern('fpc_'+
  1152. tstringdef(left.resulttype.def).stringtypname+'_compare',
  1153. ccallparanode.create(right,ccallparanode.create(left,nil)));
  1154. { and compare its result with 0 according to the original operator }
  1155. result := caddnode.create(nodetype,result,
  1156. cordconstnode.create(0,s32bittype,false));
  1157. left := nil;
  1158. right := nil;
  1159. firstpass(result);
  1160. end;
  1161. end;
  1162. end;
  1163. function taddnode.first_addset: tnode;
  1164. var
  1165. procname: string[31];
  1166. tempn: tnode;
  1167. paras: tcallparanode;
  1168. srsym: ttypesym;
  1169. begin
  1170. { get the sym that represents the fpc_normal_set type }
  1171. if not searchsystype('FPC_NORMAL_SET',srsym) then
  1172. internalerror(200108313);
  1173. case nodetype of
  1174. equaln,unequaln,lten,gten:
  1175. begin
  1176. case nodetype of
  1177. equaln,unequaln:
  1178. procname := 'fpc_set_comp_sets';
  1179. lten,gten:
  1180. begin
  1181. procname := 'fpc_set_contains_sets';
  1182. { (left >= right) = (right <= left) }
  1183. if nodetype = gten then
  1184. begin
  1185. tempn := left;
  1186. left := right;
  1187. right := tempn;
  1188. end;
  1189. end;
  1190. end;
  1191. { convert the arguments (explicitely) to fpc_normal_set's }
  1192. left := ctypeconvnode.create_explicit(left,srsym.restype);
  1193. right := ctypeconvnode.create_explicit(right,srsym.restype);
  1194. result := ccallnode.createintern(procname,ccallparanode.create(right,
  1195. ccallparanode.create(left,nil)));
  1196. { left and right are reused as parameters }
  1197. left := nil;
  1198. right := nil;
  1199. { for an unequaln, we have to negate the result of comp_sets }
  1200. if nodetype = unequaln then
  1201. result := cnotnode.create(result);
  1202. end;
  1203. addn:
  1204. begin
  1205. { optimize first loading of a set }
  1206. if (right.nodetype=setelementn) and
  1207. not(assigned(tsetelementnode(right).right)) and
  1208. is_emptyset(left) then
  1209. begin
  1210. { type cast the value to pass as argument to a byte, }
  1211. { since that's what the helper expects }
  1212. tsetelementnode(right).left :=
  1213. ctypeconvnode.create(tsetelementnode(right).left,u8bittype);
  1214. tsetelementnode(right).left.toggleflag(nf_explizit);
  1215. { set the resulttype to the actual one (otherwise it's }
  1216. { "fpc_normal_set") }
  1217. result := ccallnode.createinternres('fpc_set_create_element',
  1218. ccallparanode.create(tsetelementnode(right).left,nil),
  1219. resulttype);
  1220. { reused }
  1221. tsetelementnode(right).left := nil;
  1222. end
  1223. else
  1224. begin
  1225. if right.nodetype=setelementn then
  1226. begin
  1227. { convert the arguments to bytes, since that's what }
  1228. { the helper expects }
  1229. tsetelementnode(right).left :=
  1230. ctypeconvnode.create(tsetelementnode(right).left,
  1231. u8bittype);
  1232. tsetelementnode(right).left.toggleflag(nf_explizit);
  1233. { convert the original set (explicitely) to an }
  1234. { fpc_normal_set so we can pass it to the helper }
  1235. left := ctypeconvnode.create(left,srsym.restype);
  1236. left.toggleflag(nf_explizit);
  1237. { add a range or a single element? }
  1238. if assigned(tsetelementnode(right).right) then
  1239. begin
  1240. tsetelementnode(right).right :=
  1241. ctypeconvnode.create(tsetelementnode(right).right,
  1242. u8bittype);
  1243. tsetelementnode(right).right.toggleflag(nf_explizit);
  1244. { create the call }
  1245. result := ccallnode.createinternres('fpc_set_set_range',
  1246. ccallparanode.create(tsetelementnode(right).right,
  1247. ccallparanode.create(tsetelementnode(right).left,
  1248. ccallparanode.create(left,nil))),resulttype);
  1249. end
  1250. else
  1251. begin
  1252. result := ccallnode.createinternres('fpc_set_set_byte',
  1253. ccallparanode.create(tsetelementnode(right).left,
  1254. ccallparanode.create(left,nil)),resulttype);
  1255. end;
  1256. { remove reused parts from original node }
  1257. tsetelementnode(right).right := nil;
  1258. tsetelementnode(right).left := nil;
  1259. left := nil;
  1260. end
  1261. else
  1262. begin
  1263. { add two sets }
  1264. { convert the sets to fpc_normal_set's }
  1265. left := ctypeconvnode.create(left,srsym.restype);
  1266. left.toggleflag(nf_explizit);
  1267. right := ctypeconvnode.create(right,srsym.restype);
  1268. right.toggleflag(nf_explizit);
  1269. result := ccallnode.createinternres('fpc_set_add_sets',
  1270. ccallparanode.create(right,
  1271. ccallparanode.create(left,nil)),resulttype);
  1272. { remove reused parts from original node }
  1273. left := nil;
  1274. right := nil;
  1275. end;
  1276. end
  1277. end;
  1278. subn,symdifn,muln:
  1279. begin
  1280. { convert the sets to fpc_normal_set's }
  1281. left := ctypeconvnode.create(left,srsym.restype);
  1282. left.toggleflag(nf_explizit);
  1283. right := ctypeconvnode.create(right,srsym.restype);
  1284. right.toggleflag(nf_explizit);
  1285. paras := ccallparanode.create(right,
  1286. ccallparanode.create(left,nil));
  1287. case nodetype of
  1288. subn:
  1289. result := ccallnode.createinternres('fpc_set_sub_sets',
  1290. paras,resulttype);
  1291. symdifn:
  1292. result := ccallnode.createinternres('fpc_set_symdif_sets',
  1293. paras,resulttype);
  1294. muln:
  1295. result := ccallnode.createinternres('fpc_set_mul_sets',
  1296. paras,resulttype);
  1297. end;
  1298. { remove reused parts from original node }
  1299. left := nil;
  1300. right := nil;
  1301. end;
  1302. else
  1303. internalerror(200108311);
  1304. end;
  1305. firstpass(result);
  1306. end;
  1307. function taddnode.first_add64bitint: tnode;
  1308. var
  1309. procname: string[31];
  1310. temp: tnode;
  1311. power: longint;
  1312. begin
  1313. result := nil;
  1314. { create helper calls mul }
  1315. if nodetype <> muln then
  1316. exit;
  1317. { make sure that if there is a constant, that it's on the right }
  1318. if left.nodetype = ordconstn then
  1319. begin
  1320. temp := right;
  1321. right := left;
  1322. left := temp;
  1323. end;
  1324. { can we use a shift instead of a mul? }
  1325. if (right.nodetype = ordconstn) and
  1326. ispowerof2(tordconstnode(right).value,power) then
  1327. begin
  1328. tordconstnode(right).value := power;
  1329. result := cshlshrnode.create(shln,left,right);
  1330. { left and right are reused }
  1331. left := nil;
  1332. right := nil;
  1333. { return firstpassed new node }
  1334. firstpass(result);
  1335. exit;
  1336. end;
  1337. { otherwise, create the parameters for the helper }
  1338. right := ccallparanode.create(
  1339. cordconstnode.create(ord(cs_check_overflow in aktlocalswitches),booltype,true),
  1340. ccallparanode.create(right,ccallparanode.create(left,nil)));
  1341. left := nil;
  1342. if torddef(resulttype.def).typ = s64bit then
  1343. procname := 'fpc_mul_int64'
  1344. else
  1345. procname := 'fpc_mul_qword';
  1346. result := ccallnode.createintern(procname,right);
  1347. right := nil;
  1348. firstpass(result);
  1349. end;
  1350. function taddnode.first_addfloat: tnode;
  1351. var
  1352. procname: string[31];
  1353. temp: tnode;
  1354. power: longint;
  1355. { do we need to reverse the result ? }
  1356. notnode : boolean;
  1357. begin
  1358. result := nil;
  1359. notnode := false;
  1360. { In non-emulation mode, real opcodes are
  1361. emitted for floating point values.
  1362. }
  1363. if not (cs_fp_emulation in aktmoduleswitches) then
  1364. exit;
  1365. procname := 'FPC_REAL_';
  1366. case nodetype of
  1367. addn : procname := procname + 'ADD';
  1368. muln : procname := procname + 'MUL';
  1369. subn : procname := procname + 'SUB';
  1370. slashn : procname := procname + 'DIV';
  1371. ltn : procname := procname + 'LESS_THAN';
  1372. lten: procname := procname + 'LESS_EQUAL_THAN';
  1373. gtn:
  1374. begin
  1375. procname := procname + 'LESS_EQUAL_THAN';
  1376. notnode := true;
  1377. end;
  1378. gten:
  1379. begin
  1380. procname := procname + 'LESS_THAN';
  1381. notnode := true;
  1382. end;
  1383. equaln: procname := procname + 'EQUAL';
  1384. unequaln :
  1385. begin
  1386. procname := procname + 'EQUAL';
  1387. notnode := true;
  1388. end;
  1389. else
  1390. CGMessage(type_e_mismatch);
  1391. end;
  1392. { otherwise, create the parameters for the helper }
  1393. right := ccallparanode.create(right,ccallparanode.create(left,nil));
  1394. left := nil;
  1395. { do we need to reverse the result }
  1396. if notnode then
  1397. result := cnotnode.create(ccallnode.createintern(procname,right))
  1398. else
  1399. result := ccallnode.createintern(procname,right);
  1400. right := nil;
  1401. firstpass(result);
  1402. end;
  1403. function taddnode.pass_1 : tnode;
  1404. var
  1405. hp : tnode;
  1406. lt,rt : tnodetype;
  1407. rd,ld : tdef;
  1408. begin
  1409. result:=nil;
  1410. { first do the two subtrees }
  1411. firstpass(left);
  1412. firstpass(right);
  1413. if codegenerror then
  1414. exit;
  1415. { load easier access variables }
  1416. rd:=right.resulttype.def;
  1417. ld:=left.resulttype.def;
  1418. rt:=right.nodetype;
  1419. lt:=left.nodetype;
  1420. { int/int gives real/real! }
  1421. if nodetype=slashn then
  1422. begin
  1423. result := first_addfloat;
  1424. if assigned(result) then
  1425. exit;
  1426. location.loc:=LOC_FPUREGISTER;
  1427. { maybe we need an integer register to save }
  1428. { a reference }
  1429. if ((left.location.loc<>LOC_FPUREGISTER) or
  1430. (right.location.loc<>LOC_FPUREGISTER)) and
  1431. (left.registers32=right.registers32) then
  1432. calcregisters(self,1,1,0)
  1433. else
  1434. calcregisters(self,0,1,0);
  1435. { an add node always first loads both the left and the }
  1436. { right in the fpu before doing the calculation. However, }
  1437. { calcregisters(0,2,0) will overestimate the number of }
  1438. { necessary registers (it will make it 3 in case one of }
  1439. { the operands is already in the fpu) (JM) }
  1440. if ((left.location.loc <> LOC_FPUREGISTER) or
  1441. (right.location.loc <> LOC_FPUREGISTER)) and
  1442. (registersfpu < 2) then
  1443. inc(registersfpu);
  1444. end
  1445. { if both are orddefs then check sub types }
  1446. else if (ld.deftype=orddef) and (rd.deftype=orddef) then
  1447. begin
  1448. { 2 booleans ? }
  1449. if is_boolean(ld) and is_boolean(rd) then
  1450. begin
  1451. if not(cs_full_boolean_eval in aktlocalswitches) and
  1452. (nodetype in [andn,orn]) then
  1453. begin
  1454. location.loc:=LOC_JUMP;
  1455. calcregisters(self,0,0,0);
  1456. end
  1457. else
  1458. begin
  1459. location.loc := LOC_FLAGS;
  1460. if (left.location.loc in [LOC_JUMP,LOC_FLAGS]) and
  1461. (left.location.loc in [LOC_JUMP,LOC_FLAGS]) then
  1462. calcregisters(self,2,0,0)
  1463. else
  1464. calcregisters(self,1,0,0);
  1465. end;
  1466. end
  1467. else
  1468. { Both are chars? only convert to shortstrings for addn }
  1469. if is_char(ld) then
  1470. begin
  1471. if nodetype=addn then
  1472. internalerror(200103291);
  1473. location.loc := LOC_FLAGS;
  1474. calcregisters(self,1,0,0);
  1475. end
  1476. { is there a 64 bit type ? }
  1477. else if (torddef(ld).typ in [s64bit,u64bit]) then
  1478. begin
  1479. result := first_add64bitint;
  1480. if assigned(result) then
  1481. exit;
  1482. if nodetype in [addn,subn,muln,andn,orn,xorn] then
  1483. location.loc := LOC_REGISTER
  1484. else
  1485. location.loc := LOC_JUMP;
  1486. calcregisters(self,2,0,0)
  1487. end
  1488. { is there a cardinal? }
  1489. else if (torddef(ld).typ=u32bit) then
  1490. begin
  1491. if nodetype in [addn,subn,muln,andn,orn,xorn] then
  1492. location.loc := LOC_REGISTER
  1493. else
  1494. location.loc := LOC_FLAGS;
  1495. calcregisters(self,1,0,0);
  1496. { for unsigned mul we need an extra register }
  1497. if nodetype=muln then
  1498. inc(registers32);
  1499. end
  1500. { generic s32bit conversion }
  1501. else
  1502. begin
  1503. if nodetype in [addn,subn,muln,andn,orn,xorn] then
  1504. location.loc := LOC_REGISTER
  1505. else
  1506. location.loc := LOC_FLAGS;
  1507. calcregisters(self,1,0,0);
  1508. end;
  1509. end
  1510. { left side a setdef, must be before string processing,
  1511. else array constructor can be seen as array of char (PFV) }
  1512. else if (ld.deftype=setdef) then
  1513. begin
  1514. if tsetdef(ld).settype=smallset then
  1515. begin
  1516. location.loc:=LOC_REGISTER;
  1517. { are we adding set elements ? }
  1518. if right.nodetype=setelementn then
  1519. calcregisters(self,2,0,0)
  1520. else
  1521. calcregisters(self,1,0,0);
  1522. end
  1523. else
  1524. begin
  1525. result := first_addset;
  1526. if assigned(result) then
  1527. exit;
  1528. location.loc:=LOC_CREFERENCE;
  1529. calcregisters(self,0,0,0);
  1530. { here we call SET... }
  1531. if assigned(procinfo) then
  1532. procinfo.flags:=procinfo.flags or pi_do_call;
  1533. end;
  1534. end
  1535. { compare pchar by addresses like BP/Delphi }
  1536. else if is_pchar(ld) then
  1537. begin
  1538. location.loc:=LOC_REGISTER;
  1539. calcregisters(self,1,0,0);
  1540. end
  1541. { is one of the operands a string }
  1542. else if (ld.deftype=stringdef) then
  1543. begin
  1544. if is_widestring(ld) then
  1545. begin
  1546. { we use reference counted widestrings so no fast exit here }
  1547. if assigned(procinfo) then
  1548. procinfo.no_fast_exit:=true;
  1549. { this is only for add, the comparisaion is handled later }
  1550. location.loc:=LOC_REGISTER;
  1551. end
  1552. else if is_ansistring(ld) then
  1553. begin
  1554. { we use ansistrings so no fast exit here }
  1555. if assigned(procinfo) then
  1556. procinfo.no_fast_exit:=true;
  1557. { this is only for add, the comparisaion is handled later }
  1558. location.loc:=LOC_REGISTER;
  1559. end
  1560. else if is_longstring(ld) then
  1561. begin
  1562. { this is only for add, the comparisaion is handled later }
  1563. location.loc:=LOC_CREFERENCE;
  1564. end
  1565. else
  1566. begin
  1567. if canbeaddsstringcharoptnode(self) then
  1568. begin
  1569. hp := genaddsstringcharoptnode(self);
  1570. firstpass(hp);
  1571. pass_1 := hp;
  1572. exit;
  1573. end
  1574. else
  1575. begin
  1576. { Fix right to be shortstring }
  1577. if is_char(right.resulttype.def) then
  1578. begin
  1579. inserttypeconv(right,cshortstringtype);
  1580. firstpass(right);
  1581. end;
  1582. end;
  1583. if canbeaddsstringcsstringoptnode(self) then
  1584. begin
  1585. hp := genaddsstringcsstringoptnode(self);
  1586. firstpass(hp);
  1587. pass_1 := hp;
  1588. exit;
  1589. end;
  1590. end;
  1591. { otherwise, let addstring convert everything }
  1592. result := first_addstring;
  1593. exit;
  1594. end
  1595. { is one a real float ? }
  1596. else if (rd.deftype=floatdef) or (ld.deftype=floatdef) then
  1597. begin
  1598. result := first_addfloat;
  1599. if assigned(result) then
  1600. exit;
  1601. location.loc:=LOC_FPUREGISTER;
  1602. calcregisters(self,0,1,0);
  1603. { an add node always first loads both the left and the }
  1604. { right in the fpu before doing the calculation. However, }
  1605. { calcregisters(0,2,0) will overestimate the number of }
  1606. { necessary registers (it will make it 3 in case one of }
  1607. { the operands is already in the fpu) (JM) }
  1608. if ((left.location.loc <> LOC_FPUREGISTER) or
  1609. (right.location.loc <> LOC_FPUREGISTER)) and
  1610. (registersfpu < 2) then
  1611. inc(registersfpu);
  1612. end
  1613. { pointer comperation and subtraction }
  1614. else if (ld.deftype=pointerdef) then
  1615. begin
  1616. location.loc:=LOC_REGISTER;
  1617. calcregisters(self,1,0,0);
  1618. end
  1619. else if is_class_or_interface(ld) then
  1620. begin
  1621. location.loc:=LOC_REGISTER;
  1622. calcregisters(self,1,0,0);
  1623. end
  1624. else if (ld.deftype=classrefdef) then
  1625. begin
  1626. location.loc:=LOC_REGISTER;
  1627. calcregisters(self,1,0,0);
  1628. end
  1629. { support procvar=nil,procvar<>nil }
  1630. else if ((ld.deftype=procvardef) and (rt=niln)) or
  1631. ((rd.deftype=procvardef) and (lt=niln)) then
  1632. begin
  1633. location.loc:=LOC_REGISTER;
  1634. calcregisters(self,1,0,0);
  1635. end
  1636. {$ifdef SUPPORT_MMX}
  1637. { mmx support, this must be before the zero based array
  1638. check }
  1639. else if (cs_mmx in aktlocalswitches) and is_mmx_able_array(ld) and
  1640. is_mmx_able_array(rd) then
  1641. begin
  1642. location.loc:=LOC_MMXREGISTER;
  1643. calcregisters(self,0,0,1);
  1644. end
  1645. {$endif SUPPORT_MMX}
  1646. else if (rd.deftype=pointerdef) or (ld.deftype=pointerdef) then
  1647. begin
  1648. location.loc:=LOC_REGISTER;
  1649. calcregisters(self,1,0,0);
  1650. end
  1651. else if (rd.deftype=procvardef) and (ld.deftype=procvardef) and is_equal(rd,ld) then
  1652. begin
  1653. location.loc:=LOC_REGISTER;
  1654. calcregisters(self,1,0,0);
  1655. end
  1656. else if (ld.deftype=enumdef) then
  1657. begin
  1658. location.loc := LOC_FLAGS;
  1659. calcregisters(self,1,0,0);
  1660. end
  1661. {$ifdef SUPPORT_MMX}
  1662. else if (cs_mmx in aktlocalswitches) and
  1663. is_mmx_able_array(ld) and
  1664. is_mmx_able_array(rd) then
  1665. begin
  1666. location.loc:=LOC_MMXREGISTER;
  1667. calcregisters(self,0,0,1);
  1668. end
  1669. {$endif SUPPORT_MMX}
  1670. { the general solution is to convert to 32 bit int }
  1671. else
  1672. begin
  1673. location.loc:=LOC_REGISTER;
  1674. calcregisters(self,1,0,0);
  1675. end;
  1676. end;
  1677. {$ifdef state_tracking}
  1678. function Taddnode.track_state_pass(exec_known:boolean):boolean;
  1679. var factval:Tnode;
  1680. begin
  1681. track_state_pass:=false;
  1682. if left.track_state_pass(exec_known) then
  1683. begin
  1684. track_state_pass:=true;
  1685. left.resulttype.def:=nil;
  1686. do_resulttypepass(left);
  1687. end;
  1688. factval:=aktstate.find_fact(left);
  1689. if factval<>nil then
  1690. begin
  1691. track_state_pass:=true;
  1692. left.destroy;
  1693. left:=factval.getcopy;
  1694. end;
  1695. if right.track_state_pass(exec_known) then
  1696. begin
  1697. track_state_pass:=true;
  1698. right.resulttype.def:=nil;
  1699. do_resulttypepass(right);
  1700. end;
  1701. factval:=aktstate.find_fact(right);
  1702. if factval<>nil then
  1703. begin
  1704. track_state_pass:=true;
  1705. right.destroy;
  1706. right:=factval.getcopy;
  1707. end;
  1708. end;
  1709. {$endif}
  1710. begin
  1711. caddnode:=taddnode;
  1712. end.
  1713. {
  1714. $Log$
  1715. Revision 1.66 2002-10-04 21:19:28 jonas
  1716. * fixed web bug 2139: checking for division by zero fixed
  1717. Revision 1.65 2002/09/07 15:25:02 peter
  1718. * old logs removed and tabs fixed
  1719. Revision 1.64 2002/09/07 12:16:05 carl
  1720. * second part bug report 1996 fix, testrange in cordconstnode
  1721. only called if option is set (also make parsing a tiny faster)
  1722. Revision 1.63 2002/09/04 19:32:56 jonas
  1723. * changed some ctypeconvnode/toggleflag(nf_explizit) combo's to
  1724. ctypeconvnode.create_explicit() statements
  1725. Revision 1.62 2002/08/17 09:23:34 florian
  1726. * first part of procinfo rewrite
  1727. Revision 1.61 2002/08/15 15:15:55 carl
  1728. * jmpbuf size allocation for exceptions is now cpu specific (as it should)
  1729. * more generic nodes for maths
  1730. * several fixes for better m68k support
  1731. Revision 1.60 2002/08/12 15:08:39 carl
  1732. + stab register indexes for powerpc (moved from gdb to cpubase)
  1733. + tprocessor enumeration moved to cpuinfo
  1734. + linker in target_info is now a class
  1735. * many many updates for m68k (will soon start to compile)
  1736. - removed some ifdef or correct them for correct cpu
  1737. Revision 1.59 2002/08/02 07:44:30 jonas
  1738. * made assigned() handling generic
  1739. * add nodes now can also evaluate constant expressions at compile time
  1740. that contain nil nodes
  1741. Revision 1.58 2002/07/26 11:17:52 jonas
  1742. * the optimization of converting a multiplication with a power of two to
  1743. a shl is moved from n386add/secondpass to nadd/resulttypepass
  1744. Revision 1.57 2002/07/23 13:08:16 jonas
  1745. * fixed constant set evaluation of new set handling for non-commutative
  1746. operators
  1747. Revision 1.56 2002/07/23 12:34:29 daniel
  1748. * Readded old set code. To use it define 'oldset'. Activated by default
  1749. for ppc.
  1750. Revision 1.55 2002/07/22 11:48:04 daniel
  1751. * Sets are now internally sets.
  1752. Revision 1.54 2002/07/20 11:57:53 florian
  1753. * types.pas renamed to defbase.pas because D6 contains a types
  1754. unit so this would conflicts if D6 programms are compiled
  1755. + Willamette/SSE2 instructions to assembler added
  1756. Revision 1.53 2002/07/19 11:41:34 daniel
  1757. * State tracker work
  1758. * The whilen and repeatn are now completely unified into whilerepeatn. This
  1759. allows the state tracker to change while nodes automatically into
  1760. repeat nodes.
  1761. * Resulttypepass improvements to the notn. 'not not a' is optimized away and
  1762. 'not(a>b)' is optimized into 'a<=b'.
  1763. * Resulttypepass improvements to the whilerepeatn. 'while not a' is optimized
  1764. by removing the notn and later switchting the true and falselabels. The
  1765. same is done with 'repeat until not a'.
  1766. Revision 1.52 2002/07/14 18:00:43 daniel
  1767. + Added the beginning of a state tracker. This will track the values of
  1768. variables through procedures and optimize things away.
  1769. Revision 1.51 2002/05/18 13:34:08 peter
  1770. * readded missing revisions
  1771. Revision 1.50 2002/05/16 19:46:37 carl
  1772. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  1773. + try to fix temp allocation (still in ifdef)
  1774. + generic constructor calls
  1775. + start of tassembler / tmodulebase class cleanup
  1776. Revision 1.48 2002/05/13 19:54:36 peter
  1777. * removed n386ld and n386util units
  1778. * maybe_save/maybe_restore added instead of the old maybe_push
  1779. Revision 1.47 2002/05/12 16:53:06 peter
  1780. * moved entry and exitcode to ncgutil and cgobj
  1781. * foreach gets extra argument for passing local data to the
  1782. iterator function
  1783. * -CR checks also class typecasts at runtime by changing them
  1784. into as
  1785. * fixed compiler to cycle with the -CR option
  1786. * fixed stabs with elf writer, finally the global variables can
  1787. be watched
  1788. * removed a lot of routines from cga unit and replaced them by
  1789. calls to cgobj
  1790. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  1791. u32bit then the other is typecasted also to u32bit without giving
  1792. a rangecheck warning/error.
  1793. * fixed pascal calling method with reversing also the high tree in
  1794. the parast, detected by tcalcst3 test
  1795. Revision 1.46 2002/04/23 19:16:34 peter
  1796. * add pinline unit that inserts compiler supported functions using
  1797. one or more statements
  1798. * moved finalize and setlength from ninl to pinline
  1799. Revision 1.45 2002/04/04 19:05:56 peter
  1800. * removed unused units
  1801. * use tlocation.size in cg.a_*loc*() routines
  1802. Revision 1.44 2002/04/02 17:11:28 peter
  1803. * tlocation,treference update
  1804. * LOC_CONSTANT added for better constant handling
  1805. * secondadd splitted in multiple routines
  1806. * location_force_reg added for loading a location to a register
  1807. of a specified size
  1808. * secondassignment parses now first the right and then the left node
  1809. (this is compatible with Kylix). This saves a lot of push/pop especially
  1810. with string operations
  1811. * adapted some routines to use the new cg methods
  1812. }