nadd.pas 76 KB

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