nadd.pas 107 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711
  1. {
  2. Copyright (c) 1998-2002 by Florian Klaempfl
  3. Type checking and simplification for add nodes
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. unit nadd;
  18. {$i fpcdefs.inc}
  19. { define addstringopt}
  20. interface
  21. uses
  22. node,symtype;
  23. type
  24. taddnode = class(tbinopnode)
  25. private
  26. function pass_typecheck_internal:tnode;
  27. public
  28. resultrealdef : tdef;
  29. constructor create(tt : tnodetype;l,r : tnode);override;
  30. function pass_1 : tnode;override;
  31. function pass_typecheck:tnode;override;
  32. function simplify : tnode;override;
  33. {$ifdef state_tracking}
  34. function track_state_pass(exec_known:boolean):boolean;override;
  35. {$endif}
  36. protected
  37. { override the following if you want to implement }
  38. { parts explicitely in the code generator (JM) }
  39. function first_addstring: tnode; virtual;
  40. function first_addset: tnode; virtual;
  41. { only implements "muln" nodes, the rest always has to be done in }
  42. { the code generator for performance reasons (JM) }
  43. function first_add64bitint: tnode; virtual;
  44. { override and return false if you can handle 32x32->64 }
  45. { bit multiplies directly in your code generator. If }
  46. { this function is overridden to return false, you can }
  47. { get multiplies with left/right both s32bit or u32bit, }
  48. { and resultdef of the muln s64bit or u64bit }
  49. function use_generic_mul32to64: boolean; virtual;
  50. { This routine calls internal runtime library helpers
  51. for all floating point arithmetic in the case
  52. where the emulation switches is on. Otherwise
  53. returns nil, and everything must be done in
  54. the code generation phase.
  55. }
  56. function first_addfloat : tnode; virtual;
  57. private
  58. { checks whether a muln can be calculated as a 32bit }
  59. { * 32bit -> 64 bit }
  60. function try_make_mul32to64: boolean;
  61. end;
  62. taddnodeclass = class of taddnode;
  63. var
  64. { caddnode is used to create nodes of the add type }
  65. { the virtual constructor allows to assign }
  66. { another class type to caddnode => processor }
  67. { specific node types can be created }
  68. caddnode : taddnodeclass;
  69. implementation
  70. uses
  71. {$IFNDEF USE_FAKE_SYSUTILS}
  72. sysutils,
  73. {$ELSE}
  74. fksysutl,
  75. {$ENDIF}
  76. globtype,systems,constexp,
  77. cutils,verbose,globals,widestr,
  78. symconst,symdef,symsym,symtable,defutil,defcmp,
  79. cgbase,
  80. htypechk,pass_1,
  81. nld,nbas,nmat,ncnv,ncon,nset,nopt,ncal,ninl,nmem,nutils,
  82. {$ifdef state_tracking}
  83. nstate,
  84. {$endif}
  85. cpuinfo,procinfo;
  86. {*****************************************************************************
  87. TADDNODE
  88. *****************************************************************************}
  89. {$maxfpuregisters 0}
  90. function getbestreal(t1,t2 : tdef) : tdef;
  91. const
  92. floatweight : array[tfloattype] of byte =
  93. (2,3,4,0,1,5);
  94. begin
  95. if t1.typ=floatdef then
  96. begin
  97. result:=t1;
  98. if t2.typ=floatdef then
  99. begin
  100. { when a comp or currency is used, use always the
  101. best float type to calculate the result }
  102. if (tfloatdef(t2).floattype in [s64comp,s64currency]) or
  103. (tfloatdef(t2).floattype in [s64comp,s64currency]) then
  104. result:=pbestrealtype^
  105. else
  106. if floatweight[tfloatdef(t2).floattype]>floatweight[tfloatdef(t1).floattype] then
  107. result:=t2;
  108. end;
  109. end
  110. else if t2.typ=floatdef then
  111. result:=t2
  112. else internalerror(200508061);
  113. end;
  114. constructor taddnode.create(tt : tnodetype;l,r : tnode);
  115. begin
  116. inherited create(tt,l,r);
  117. end;
  118. function taddnode.simplify : tnode;
  119. var
  120. t, hp : tnode;
  121. lt,rt : tnodetype;
  122. realdef : tdef;
  123. rd,ld : tdef;
  124. rv,lv,v : tconstexprint;
  125. rvd,lvd : bestreal;
  126. ws1,ws2 : pcompilerwidestring;
  127. concatstrings : boolean;
  128. c1,c2 : array[0..1] of char;
  129. s1,s2 : pchar;
  130. l1,l2 : longint;
  131. resultset : Tconstset;
  132. b : boolean;
  133. begin
  134. result:=nil;
  135. { load easier access variables }
  136. rd:=right.resultdef;
  137. ld:=left.resultdef;
  138. rt:=right.nodetype;
  139. lt:=left.nodetype;
  140. if (nodetype = slashn) and
  141. (((rt = ordconstn) and
  142. (tordconstnode(right).value = 0)) or
  143. ((rt = realconstn) and
  144. (trealconstnode(right).value_real = 0.0))) then
  145. begin
  146. if floating_point_range_check_error then
  147. begin
  148. result:=crealconstnode.create(1,pbestrealtype^);
  149. Message(parser_e_division_by_zero);
  150. exit;
  151. end;
  152. end;
  153. { both are int constants }
  154. if (
  155. (
  156. is_constintnode(left) and
  157. is_constintnode(right)
  158. ) or
  159. (
  160. is_constboolnode(left) and
  161. is_constboolnode(right) and
  162. (nodetype in [slashn,ltn,lten,gtn,gten,equaln,unequaln,andn,xorn,orn])
  163. ) or
  164. (
  165. is_constenumnode(left) and
  166. is_constenumnode(right) and
  167. allowenumop(nodetype))
  168. ) or
  169. (
  170. (lt = pointerconstn) and
  171. is_constintnode(right) and
  172. (nodetype in [addn,subn])
  173. ) or
  174. (
  175. (lt in [pointerconstn,niln]) and
  176. (rt in [pointerconstn,niln]) and
  177. (nodetype in [ltn,lten,gtn,gten,equaln,unequaln,subn])
  178. ) then
  179. begin
  180. t:=nil;
  181. { load values }
  182. case lt of
  183. ordconstn:
  184. lv:=tordconstnode(left).value;
  185. pointerconstn:
  186. lv:=tpointerconstnode(left).value;
  187. niln:
  188. lv:=0;
  189. else
  190. internalerror(2002080202);
  191. end;
  192. case rt of
  193. ordconstn:
  194. rv:=tordconstnode(right).value;
  195. pointerconstn:
  196. rv:=tpointerconstnode(right).value;
  197. niln:
  198. rv:=0;
  199. else
  200. internalerror(2002080203);
  201. end;
  202. { type checking already took care of multiplying }
  203. { integer constants with pointeddef.size if necessary }
  204. case nodetype of
  205. addn :
  206. begin
  207. v:=lv+rv;
  208. if v.overflow then
  209. begin
  210. Message(parser_e_arithmetic_operation_overflow);
  211. { Recover }
  212. t:=genintconstnode(0)
  213. end
  214. else if (lt=pointerconstn) then
  215. t := cpointerconstnode.create(qword(v),resultdef)
  216. else
  217. if is_integer(ld) then
  218. t := genintconstnode(v)
  219. else
  220. t := cordconstnode.create(v,resultdef,(ld.typ<>enumdef));
  221. end;
  222. subn :
  223. begin
  224. v:=lv-rv;
  225. if v.overflow then
  226. begin
  227. Message(parser_e_arithmetic_operation_overflow);
  228. { Recover }
  229. t:=genintconstnode(0)
  230. end
  231. else if (lt=pointerconstn) then
  232. { pointer-pointer results in an integer }
  233. if (rt=pointerconstn) then
  234. begin
  235. if not(nf_has_pointerdiv in flags) then
  236. internalerror(2008030101);
  237. t := genintconstnode(v)
  238. end
  239. else
  240. t := cpointerconstnode.create(qword(v),resultdef)
  241. else
  242. if is_integer(ld) then
  243. t:=genintconstnode(v)
  244. else
  245. t:=cordconstnode.create(v,resultdef,(ld.typ<>enumdef));
  246. end;
  247. muln :
  248. begin
  249. v:=lv*rv;
  250. if v.overflow then
  251. begin
  252. message(parser_e_arithmetic_operation_overflow);
  253. { Recover }
  254. t:=genintconstnode(0)
  255. end
  256. else
  257. t:=genintconstnode(v)
  258. end;
  259. xorn :
  260. if is_integer(ld) then
  261. t:=genintconstnode(lv xor rv)
  262. else
  263. t:=cordconstnode.create(lv xor rv,resultdef,true);
  264. orn :
  265. if is_integer(ld) then
  266. t:=genintconstnode(lv or rv)
  267. else
  268. t:=cordconstnode.create(lv or rv,resultdef,true);
  269. andn :
  270. if is_integer(ld) then
  271. t:=genintconstnode(lv and rv)
  272. else
  273. t:=cordconstnode.create(lv and rv,resultdef,true);
  274. ltn :
  275. t:=cordconstnode.create(ord(lv<rv),booltype,true);
  276. lten :
  277. t:=cordconstnode.create(ord(lv<=rv),booltype,true);
  278. gtn :
  279. t:=cordconstnode.create(ord(lv>rv),booltype,true);
  280. gten :
  281. t:=cordconstnode.create(ord(lv>=rv),booltype,true);
  282. equaln :
  283. t:=cordconstnode.create(ord(lv=rv),booltype,true);
  284. unequaln :
  285. t:=cordconstnode.create(ord(lv<>rv),booltype,true);
  286. slashn :
  287. begin
  288. { int/int becomes a real }
  289. rvd:=rv;
  290. lvd:=lv;
  291. t:=crealconstnode.create(lvd/rvd,resultrealdef);
  292. end;
  293. else
  294. internalerror(2008022101);
  295. end;
  296. result:=t;
  297. exit;
  298. end
  299. {Match against the ranges, i.e.:
  300. var a:1..10;
  301. begin
  302. if a>0 then
  303. ... always evaluates to true. (DM)}
  304. else if is_constintnode(left) and (right.resultdef.typ=orddef) and
  305. { don't ignore type checks }
  306. is_subequal(left.resultdef,right.resultdef) then
  307. begin
  308. t:=nil;
  309. hp:=right;
  310. realdef:=hp.resultdef;
  311. while (hp.nodetype=typeconvn) and
  312. ([nf_internal,nf_explicit] * hp.flags = []) and
  313. is_in_limit(ttypeconvnode(hp).left.resultdef,realdef) do
  314. begin
  315. hp:=ttypeconvnode(hp).left;
  316. realdef:=hp.resultdef;
  317. end;
  318. lv:=Tordconstnode(left).value;
  319. with torddef(realdef) do
  320. case nodetype of
  321. ltn:
  322. if lv<low then
  323. t:=Cordconstnode.create(1,booltype,true)
  324. else if lv>=high then
  325. t:=Cordconstnode.create(0,booltype,true);
  326. lten:
  327. if lv<=low then
  328. t:=Cordconstnode.create(1,booltype,true)
  329. else if lv>high then
  330. t:=Cordconstnode.create(0,booltype,true);
  331. gtn:
  332. if lv<=low then
  333. t:=Cordconstnode.create(0,booltype,true)
  334. else if lv>high then
  335. t:=Cordconstnode.create(1,booltype,true);
  336. gten :
  337. if lv<low then
  338. t:=Cordconstnode.create(0,booltype,true)
  339. else if lv>=high then
  340. t:=Cordconstnode.create(1,booltype,true);
  341. equaln:
  342. if (lv<low) or (lv>high) then
  343. t:=Cordconstnode.create(0,booltype,true);
  344. unequaln:
  345. if (lv<low) or (lv>high) then
  346. t:=Cordconstnode.create(1,booltype,true);
  347. end;
  348. if t<>nil then
  349. begin
  350. result:=t;
  351. exit;
  352. end
  353. end
  354. else if (left.resultdef.typ=orddef) and is_constintnode(right) and
  355. { don't ignore type checks }
  356. is_subequal(left.resultdef,right.resultdef) then
  357. begin
  358. t:=nil;
  359. hp:=left;
  360. realdef:=hp.resultdef;
  361. while (hp.nodetype=typeconvn) and
  362. ([nf_internal,nf_explicit] * hp.flags = []) and
  363. is_in_limit(ttypeconvnode(hp).left.resultdef,realdef) do
  364. begin
  365. hp:=ttypeconvnode(hp).left;
  366. realdef:=hp.resultdef;
  367. end;
  368. rv:=Tordconstnode(right).value;
  369. with torddef(realdef) do
  370. case nodetype of
  371. ltn:
  372. if high<rv then
  373. t:=Cordconstnode.create(1,booltype,true)
  374. else if low>=rv then
  375. t:=Cordconstnode.create(0,booltype,true);
  376. lten:
  377. if high<=rv then
  378. t:=Cordconstnode.create(1,booltype,true)
  379. else if low>rv then
  380. t:=Cordconstnode.create(0,booltype,true);
  381. gtn:
  382. if high<=rv then
  383. t:=Cordconstnode.create(0,booltype,true)
  384. else if low>rv then
  385. t:=Cordconstnode.create(1,booltype,true);
  386. gten:
  387. if high<rv then
  388. t:=Cordconstnode.create(0,booltype,true)
  389. else if low>=rv then
  390. t:=Cordconstnode.create(1,booltype,true);
  391. equaln:
  392. if (rv<low) or (rv>high) then
  393. t:=Cordconstnode.create(0,booltype,true);
  394. unequaln:
  395. if (rv<low) or (rv>high) then
  396. t:=Cordconstnode.create(1,booltype,true);
  397. end;
  398. if t<>nil then
  399. begin
  400. result:=t;
  401. exit;
  402. end
  403. end;
  404. { Add,Sub,Mul with constant 0, 1 or -1? }
  405. if is_constintnode(right) and is_integer(left.resultdef) then
  406. begin
  407. if tordconstnode(right).value = 0 then
  408. begin
  409. case nodetype of
  410. addn,subn:
  411. result := left.getcopy;
  412. muln:
  413. result:=cordconstnode.create(0,resultdef,true);
  414. end;
  415. end
  416. else if tordconstnode(right).value = 1 then
  417. begin
  418. case nodetype of
  419. muln:
  420. result := left.getcopy;
  421. end;
  422. end
  423. {$ifdef VER2_2}
  424. else if (tordconstnode(right).value.svalue = -1) and (tordconstnode(right).value.signed) then
  425. {$else}
  426. else if tordconstnode(right).value = -1 then
  427. {$endif}
  428. begin
  429. case nodetype of
  430. muln:
  431. result := cunaryminusnode.create(left.getcopy);
  432. end;
  433. end;
  434. if assigned(result) then
  435. exit;
  436. end;
  437. if is_constintnode(left) and is_integer(right.resultdef) then
  438. begin
  439. if tordconstnode(left).value = 0 then
  440. begin
  441. case nodetype of
  442. addn:
  443. result := right.getcopy;
  444. subn:
  445. result := cunaryminusnode.create(right.getcopy);
  446. muln:
  447. result:=cordconstnode.create(0,right.resultdef,true);
  448. end;
  449. end
  450. else if tordconstnode(left).value = 1 then
  451. begin
  452. case nodetype of
  453. muln:
  454. result := right.getcopy;
  455. end;
  456. end
  457. {$ifdef VER2_2}
  458. else if (tordconstnode(left).value.svalue = -1) and (tordconstnode(left).value.signed) then
  459. {$else}
  460. else if tordconstnode(left).value = -1 then
  461. {$endif}
  462. begin
  463. case nodetype of
  464. muln:
  465. result := cunaryminusnode.create(right.getcopy);
  466. end;
  467. end;
  468. if assigned(result) then
  469. exit;
  470. end;
  471. { both real constants ? }
  472. if (lt=realconstn) and (rt=realconstn) then
  473. begin
  474. lvd:=trealconstnode(left).value_real;
  475. rvd:=trealconstnode(right).value_real;
  476. case nodetype of
  477. addn :
  478. t:=crealconstnode.create(lvd+rvd,resultrealdef);
  479. subn :
  480. t:=crealconstnode.create(lvd-rvd,resultrealdef);
  481. muln :
  482. t:=crealconstnode.create(lvd*rvd,resultrealdef);
  483. starstarn:
  484. begin
  485. if lvd<0 then
  486. begin
  487. Message(parser_e_invalid_float_operation);
  488. t:=crealconstnode.create(0,resultrealdef);
  489. end
  490. else if lvd=0 then
  491. t:=crealconstnode.create(1.0,resultrealdef)
  492. else
  493. t:=crealconstnode.create(exp(ln(lvd)*rvd),resultrealdef);
  494. end;
  495. slashn :
  496. t:=crealconstnode.create(lvd/rvd,resultrealdef);
  497. ltn :
  498. t:=cordconstnode.create(ord(lvd<rvd),booltype,true);
  499. lten :
  500. t:=cordconstnode.create(ord(lvd<=rvd),booltype,true);
  501. gtn :
  502. t:=cordconstnode.create(ord(lvd>rvd),booltype,true);
  503. gten :
  504. t:=cordconstnode.create(ord(lvd>=rvd),booltype,true);
  505. equaln :
  506. t:=cordconstnode.create(ord(lvd=rvd),booltype,true);
  507. unequaln :
  508. t:=cordconstnode.create(ord(lvd<>rvd),booltype,true);
  509. else
  510. internalerror(2008022102);
  511. end;
  512. result:=t;
  513. exit;
  514. end;
  515. { first, we handle widestrings, so we can check later for }
  516. { stringconstn only }
  517. { widechars are converted above to widestrings too }
  518. { this isn't ver y efficient, but I don't think }
  519. { that it does matter that much (FK) }
  520. if (lt=stringconstn) and (rt=stringconstn) and
  521. (tstringconstnode(left).cst_type in [cst_widestring,cst_unicodestring]) and
  522. (tstringconstnode(right).cst_type in [cst_widestring,cst_unicodestring]) then
  523. begin
  524. initwidestring(ws1);
  525. initwidestring(ws2);
  526. copywidestring(pcompilerwidestring(tstringconstnode(left).value_str),ws1);
  527. copywidestring(pcompilerwidestring(tstringconstnode(right).value_str),ws2);
  528. case nodetype of
  529. addn :
  530. begin
  531. concatwidestrings(ws1,ws2);
  532. t:=cstringconstnode.createwstr(ws1);
  533. end;
  534. ltn :
  535. t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<0),booltype,true);
  536. lten :
  537. t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<=0),booltype,true);
  538. gtn :
  539. t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)>0),booltype,true);
  540. gten :
  541. t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)>=0),booltype,true);
  542. equaln :
  543. t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)=0),booltype,true);
  544. unequaln :
  545. t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<>0),booltype,true);
  546. else
  547. internalerror(2008022103);
  548. end;
  549. donewidestring(ws1);
  550. donewidestring(ws2);
  551. result:=t;
  552. exit;
  553. end;
  554. { concating strings ? }
  555. concatstrings:=false;
  556. if (lt=ordconstn) and (rt=ordconstn) and
  557. is_char(ld) and is_char(rd) then
  558. begin
  559. c1[0]:=char(int64(tordconstnode(left).value));
  560. c1[1]:=#0;
  561. l1:=1;
  562. c2[0]:=char(int64(tordconstnode(right).value));
  563. c2[1]:=#0;
  564. l2:=1;
  565. s1:=@c1[0];
  566. s2:=@c2[0];
  567. concatstrings:=true;
  568. end
  569. else if (lt=stringconstn) and (rt=ordconstn) and is_char(rd) then
  570. begin
  571. s1:=tstringconstnode(left).value_str;
  572. l1:=tstringconstnode(left).len;
  573. c2[0]:=char(int64(tordconstnode(right).value));
  574. c2[1]:=#0;
  575. s2:=@c2[0];
  576. l2:=1;
  577. concatstrings:=true;
  578. end
  579. else if (lt=ordconstn) and (rt=stringconstn) and is_char(ld) then
  580. begin
  581. c1[0]:=char(int64(tordconstnode(left).value));
  582. c1[1]:=#0;
  583. l1:=1;
  584. s1:=@c1[0];
  585. s2:=tstringconstnode(right).value_str;
  586. l2:=tstringconstnode(right).len;
  587. concatstrings:=true;
  588. end
  589. else if (lt=stringconstn) and (rt=stringconstn) then
  590. begin
  591. s1:=tstringconstnode(left).value_str;
  592. l1:=tstringconstnode(left).len;
  593. s2:=tstringconstnode(right).value_str;
  594. l2:=tstringconstnode(right).len;
  595. concatstrings:=true;
  596. end;
  597. if concatstrings then
  598. begin
  599. case nodetype of
  600. addn :
  601. t:=cstringconstnode.createpchar(concatansistrings(s1,s2,l1,l2),l1+l2);
  602. ltn :
  603. t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<0),booltype,true);
  604. lten :
  605. t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<=0),booltype,true);
  606. gtn :
  607. t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)>0),booltype,true);
  608. gten :
  609. t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)>=0),booltype,true);
  610. equaln :
  611. t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)=0),booltype,true);
  612. unequaln :
  613. t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<>0),booltype,true);
  614. else
  615. internalerror(2008022104);
  616. end;
  617. result:=t;
  618. exit;
  619. end;
  620. { set constant evaluation }
  621. if (right.nodetype=setconstn) and
  622. not assigned(tsetconstnode(right).left) and
  623. (left.nodetype=setconstn) and
  624. not assigned(tsetconstnode(left).left) then
  625. begin
  626. case nodetype of
  627. addn :
  628. begin
  629. resultset:=tsetconstnode(right).value_set^ + tsetconstnode(left).value_set^;
  630. t:=csetconstnode.create(@resultset,resultdef);
  631. end;
  632. muln :
  633. begin
  634. resultset:=tsetconstnode(right).value_set^ * tsetconstnode(left).value_set^;
  635. t:=csetconstnode.create(@resultset,resultdef);
  636. end;
  637. subn :
  638. begin
  639. resultset:=tsetconstnode(left).value_set^ - tsetconstnode(right).value_set^;
  640. t:=csetconstnode.create(@resultset,resultdef);
  641. end;
  642. symdifn :
  643. begin
  644. resultset:=tsetconstnode(right).value_set^ >< tsetconstnode(left).value_set^;
  645. t:=csetconstnode.create(@resultset,resultdef);
  646. end;
  647. unequaln :
  648. begin
  649. b:=tsetconstnode(right).value_set^ <> tsetconstnode(left).value_set^;
  650. t:=cordconstnode.create(byte(b),booltype,true);
  651. end;
  652. equaln :
  653. begin
  654. b:=tsetconstnode(right).value_set^ = tsetconstnode(left).value_set^;
  655. t:=cordconstnode.create(byte(b),booltype,true);
  656. end;
  657. lten :
  658. begin
  659. b:=tsetconstnode(left).value_set^ <= tsetconstnode(right).value_set^;
  660. t:=cordconstnode.create(byte(b),booltype,true);
  661. end;
  662. gten :
  663. begin
  664. b:=tsetconstnode(left).value_set^ >= tsetconstnode(right).value_set^;
  665. t:=cordconstnode.create(byte(b),booltype,true);
  666. end;
  667. else
  668. internalerror(2008022105);
  669. end;
  670. result:=t;
  671. exit;
  672. end;
  673. end;
  674. function taddnode.pass_typecheck:tnode;
  675. begin
  676. { This function is small to keep the stack small for recursive of
  677. large + operations }
  678. typecheckpass(left);
  679. typecheckpass(right);
  680. result:=pass_typecheck_internal;
  681. end;
  682. function taddnode.pass_typecheck_internal:tnode;
  683. var
  684. hp : tnode;
  685. rd,ld,nd : tdef;
  686. hsym : tfieldvarsym;
  687. llow,lhigh,
  688. rlow,rhigh : tconstexprint;
  689. strtype : tstringtype;
  690. b : boolean;
  691. lt,rt : tnodetype;
  692. ot : tnodetype;
  693. {$ifdef state_tracking}
  694. factval : Tnode;
  695. change : boolean;
  696. {$endif}
  697. begin
  698. result:=nil;
  699. { both left and right need to be valid }
  700. set_varstate(left,vs_read,[vsf_must_be_valid]);
  701. set_varstate(right,vs_read,[vsf_must_be_valid]);
  702. if codegenerror then
  703. exit;
  704. { tp procvar support }
  705. maybe_call_procvar(left,true);
  706. maybe_call_procvar(right,true);
  707. { convert array constructors to sets, because there is no other operator
  708. possible for array constructors }
  709. if is_array_constructor(left.resultdef) then
  710. begin
  711. arrayconstructor_to_set(left);
  712. typecheckpass(left);
  713. end;
  714. if is_array_constructor(right.resultdef) then
  715. begin
  716. arrayconstructor_to_set(right);
  717. typecheckpass(right);
  718. end;
  719. { allow operator overloading }
  720. hp:=self;
  721. if isbinaryoverloaded(hp) then
  722. begin
  723. result:=hp;
  724. exit;
  725. end;
  726. { Stop checking when an error was found in the operator checking }
  727. if codegenerror then
  728. begin
  729. result:=cerrornode.create;
  730. exit;
  731. end;
  732. { Kylix allows enum+ordconstn in an enum declaration (blocktype
  733. is bt_type), we need to do the conversion here before the
  734. constant folding }
  735. if (m_delphi in current_settings.modeswitches) and
  736. (blocktype=bt_type) then
  737. begin
  738. if (left.resultdef.typ=enumdef) and
  739. (right.resultdef.typ=orddef) then
  740. begin
  741. { insert explicit typecast to default signed int }
  742. left:=ctypeconvnode.create_internal(left,sinttype);
  743. typecheckpass(left);
  744. end
  745. else
  746. if (left.resultdef.typ=orddef) and
  747. (right.resultdef.typ=enumdef) then
  748. begin
  749. { insert explicit typecast to default signed int }
  750. right:=ctypeconvnode.create_internal(right,sinttype);
  751. typecheckpass(right);
  752. end;
  753. end;
  754. { is one a real float, then both need to be floats, this
  755. need to be done before the constant folding so constant
  756. operation on a float and int are also handled }
  757. resultrealdef:=pbestrealtype^;
  758. if (right.resultdef.typ=floatdef) or (left.resultdef.typ=floatdef) then
  759. begin
  760. { when both floattypes are already equal then use that
  761. floattype for results }
  762. if (right.resultdef.typ=floatdef) and
  763. (left.resultdef.typ=floatdef) and
  764. (tfloatdef(left.resultdef).floattype=tfloatdef(right.resultdef).floattype) then
  765. resultrealdef:=left.resultdef
  766. { when there is a currency type then use currency, but
  767. only when currency is defined as float }
  768. else
  769. if (is_currency(right.resultdef) or
  770. is_currency(left.resultdef)) and
  771. ((s64currencytype.typ = floatdef) or
  772. (nodetype <> slashn)) then
  773. begin
  774. resultrealdef:=s64currencytype;
  775. inserttypeconv(right,resultrealdef);
  776. inserttypeconv(left,resultrealdef);
  777. end
  778. else
  779. begin
  780. resultrealdef:=getbestreal(left.resultdef,right.resultdef);
  781. inserttypeconv(right,resultrealdef);
  782. inserttypeconv(left,resultrealdef);
  783. end;
  784. end;
  785. { If both operands are constant and there is a widechar
  786. or widestring then convert everything to widestring. This
  787. allows constant folding like char+widechar }
  788. if is_constnode(right) and is_constnode(left) and
  789. (is_widestring(right.resultdef) or
  790. is_widestring(left.resultdef) or
  791. is_unicodestring(right.resultdef) or
  792. is_unicodestring(left.resultdef) or
  793. is_widechar(right.resultdef) or
  794. is_widechar(left.resultdef)) then
  795. begin
  796. inserttypeconv(right,cwidestringtype);
  797. inserttypeconv(left,cwidestringtype);
  798. end;
  799. { load easier access variables }
  800. rd:=right.resultdef;
  801. ld:=left.resultdef;
  802. rt:=right.nodetype;
  803. lt:=left.nodetype;
  804. { 4 character constant strings are compatible with orddef }
  805. { in macpas mode (become cardinals) }
  806. if (m_mac in current_settings.modeswitches) and
  807. { only allow for comparisons, additions etc are }
  808. { normally program errors }
  809. (nodetype in [ltn,lten,gtn,gten,unequaln,equaln]) and
  810. (((lt=stringconstn) and
  811. (tstringconstnode(left).len=4) and
  812. (rd.typ=orddef)) or
  813. ((rt=stringconstn) and
  814. (tstringconstnode(right).len=4) and
  815. (ld.typ=orddef))) then
  816. begin
  817. if (rt=stringconstn) then
  818. begin
  819. inserttypeconv(right,u32inttype);
  820. rt:=right.nodetype;
  821. rd:=right.resultdef;
  822. end
  823. else
  824. begin
  825. inserttypeconv(left,u32inttype);
  826. lt:=left.nodetype;
  827. ld:=left.resultdef;
  828. end;
  829. end;
  830. { but an int/int gives real/real! }
  831. if (nodetype=slashn) and not(is_vector(left.resultdef)) and not(is_vector(right.resultdef)) then
  832. begin
  833. if is_currency(left.resultdef) and
  834. is_currency(right.resultdef) then
  835. { In case of currency, converting to float means dividing by 10000 }
  836. { However, since this is already a division, both divisions by }
  837. { 10000 are eliminated when we divide the results -> we can skip }
  838. { them. }
  839. if s64currencytype.typ = floatdef then
  840. begin
  841. { there's no s64comptype or so, how do we avoid the type conversion?
  842. left.resultdef := s64comptype;
  843. right.resultdef := s64comptype; }
  844. end
  845. else
  846. begin
  847. left.resultdef := s64inttype;
  848. right.resultdef := s64inttype;
  849. end;
  850. inserttypeconv(right,resultrealdef);
  851. inserttypeconv(left,resultrealdef);
  852. end
  853. { if both are orddefs then check sub types }
  854. else if (ld.typ=orddef) and (rd.typ=orddef) then
  855. begin
  856. { set for & and | operations in macpas mode: they only work on }
  857. { booleans, and always short circuit evaluation }
  858. if (nf_short_bool in flags) then
  859. begin
  860. if not is_boolean(ld) then
  861. begin
  862. inserttypeconv(left,booltype);
  863. ld := left.resultdef;
  864. end;
  865. if not is_boolean(rd) then
  866. begin
  867. inserttypeconv(right,booltype);
  868. rd := right.resultdef;
  869. end;
  870. end;
  871. { 2 booleans? Make them equal to the largest boolean }
  872. if (is_boolean(ld) and is_boolean(rd)) or
  873. (nf_short_bool in flags) then
  874. begin
  875. if (torddef(left.resultdef).size>torddef(right.resultdef).size) or
  876. (is_cbool(left.resultdef) and not is_cbool(right.resultdef)) then
  877. begin
  878. right:=ctypeconvnode.create_internal(right,left.resultdef);
  879. ttypeconvnode(right).convtype:=tc_bool_2_bool;
  880. typecheckpass(right);
  881. end
  882. else if (torddef(left.resultdef).size<torddef(right.resultdef).size) or
  883. (not is_cbool(left.resultdef) and is_cbool(right.resultdef)) then
  884. begin
  885. left:=ctypeconvnode.create_internal(left,right.resultdef);
  886. ttypeconvnode(left).convtype:=tc_bool_2_bool;
  887. typecheckpass(left);
  888. end;
  889. case nodetype of
  890. xorn,
  891. ltn,
  892. lten,
  893. gtn,
  894. gten,
  895. andn,
  896. orn:
  897. begin
  898. end;
  899. unequaln,
  900. equaln:
  901. begin
  902. if not(cs_full_boolean_eval in current_settings.localswitches) or
  903. (nf_short_bool in flags) then
  904. begin
  905. { Remove any compares with constants }
  906. if (left.nodetype=ordconstn) then
  907. begin
  908. hp:=right;
  909. b:=(tordconstnode(left).value<>0);
  910. ot:=nodetype;
  911. left.free;
  912. left:=nil;
  913. right:=nil;
  914. if (not(b) and (ot=equaln)) or
  915. (b and (ot=unequaln)) then
  916. begin
  917. hp:=cnotnode.create(hp);
  918. end;
  919. result:=hp;
  920. exit;
  921. end;
  922. if (right.nodetype=ordconstn) then
  923. begin
  924. hp:=left;
  925. b:=(tordconstnode(right).value<>0);
  926. ot:=nodetype;
  927. right.free;
  928. right:=nil;
  929. left:=nil;
  930. if (not(b) and (ot=equaln)) or
  931. (b and (ot=unequaln)) then
  932. begin
  933. hp:=cnotnode.create(hp);
  934. end;
  935. result:=hp;
  936. exit;
  937. end;
  938. end;
  939. end;
  940. else
  941. begin
  942. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  943. result:=cnothingnode.create;
  944. exit;
  945. end;
  946. end;
  947. end
  948. { Both are chars? }
  949. else if is_char(rd) and is_char(ld) then
  950. begin
  951. if nodetype=addn then
  952. begin
  953. resultdef:=cshortstringtype;
  954. if not(is_constcharnode(left) and is_constcharnode(right)) then
  955. begin
  956. inserttypeconv(left,cshortstringtype);
  957. {$ifdef addstringopt}
  958. hp := genaddsstringcharoptnode(self);
  959. result := hp;
  960. exit;
  961. {$endif addstringopt}
  962. end
  963. end
  964. else if not(nodetype in [ltn,lten,gtn,gten,unequaln,equaln]) then
  965. begin
  966. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  967. result:=cnothingnode.create;
  968. exit;
  969. end;
  970. end
  971. { There is a widechar? }
  972. else if is_widechar(rd) or is_widechar(ld) then
  973. begin
  974. { widechar+widechar gives widestring }
  975. if nodetype=addn then
  976. begin
  977. inserttypeconv(left,cwidestringtype);
  978. if (torddef(rd).ordtype<>uwidechar) then
  979. inserttypeconv(right,cwidechartype);
  980. resultdef:=cwidestringtype;
  981. end
  982. else
  983. begin
  984. if (torddef(ld).ordtype<>uwidechar) then
  985. inserttypeconv(left,cwidechartype);
  986. if (torddef(rd).ordtype<>uwidechar) then
  987. inserttypeconv(right,cwidechartype);
  988. end;
  989. end
  990. { is there a currency type ? }
  991. else if ((torddef(rd).ordtype=scurrency) or (torddef(ld).ordtype=scurrency)) then
  992. begin
  993. if (torddef(ld).ordtype<>scurrency) then
  994. inserttypeconv(left,s64currencytype);
  995. if (torddef(rd).ordtype<>scurrency) then
  996. inserttypeconv(right,s64currencytype);
  997. end
  998. { "and" does't care about the sign of integers }
  999. { "xor", "or" and compares don't need extension to native int }
  1000. { size either as long as both values are signed or unsigned }
  1001. { "xor" and "or" also don't care about the sign if the values }
  1002. { occupy an entire register }
  1003. else if is_integer(ld) and is_integer(rd) and
  1004. ((nodetype=andn) or
  1005. ((nodetype in [orn,xorn,equaln,unequaln,gtn,gten,ltn,lten]) and
  1006. not(is_signed(ld) xor is_signed(rd)))) then
  1007. begin
  1008. if (rd.size>ld.size) or
  1009. { Delphi-compatible: prefer unsigned type for "and" with equal size }
  1010. ((rd.size=ld.size) and
  1011. not is_signed(rd)) then
  1012. begin
  1013. if (rd.size=ld.size) and
  1014. is_signed(ld) then
  1015. inserttypeconv_internal(left,right.resultdef)
  1016. else
  1017. inserttypeconv(left,right.resultdef)
  1018. end
  1019. else
  1020. begin
  1021. if (rd.size=ld.size) and
  1022. is_signed(rd) then
  1023. inserttypeconv_internal(right,left.resultdef)
  1024. else
  1025. inserttypeconv(right,left.resultdef)
  1026. end
  1027. end
  1028. { is there a signed 64 bit type ? }
  1029. else if ((torddef(rd).ordtype=s64bit) or (torddef(ld).ordtype=s64bit)) then
  1030. begin
  1031. if (torddef(ld).ordtype<>s64bit) then
  1032. inserttypeconv(left,s64inttype);
  1033. if (torddef(rd).ordtype<>s64bit) then
  1034. inserttypeconv(right,s64inttype);
  1035. end
  1036. { is there a unsigned 64 bit type ? }
  1037. else if ((torddef(rd).ordtype=u64bit) or (torddef(ld).ordtype=u64bit)) then
  1038. begin
  1039. if (torddef(ld).ordtype<>u64bit) then
  1040. inserttypeconv(left,u64inttype);
  1041. if (torddef(rd).ordtype<>u64bit) then
  1042. inserttypeconv(right,u64inttype);
  1043. end
  1044. { 64 bit cpus do calculations always in 64 bit }
  1045. {$ifndef cpu64bitaddr}
  1046. { is there a cardinal? }
  1047. else if ((torddef(rd).ordtype=u32bit) or (torddef(ld).ordtype=u32bit)) then
  1048. begin
  1049. { convert positive constants to u32bit }
  1050. if (torddef(ld).ordtype<>u32bit) and
  1051. is_constintnode(left) and
  1052. (tordconstnode(left).value >= 0) then
  1053. inserttypeconv(left,u32inttype);
  1054. if (torddef(rd).ordtype<>u32bit) and
  1055. is_constintnode(right) and
  1056. (tordconstnode(right).value >= 0) then
  1057. inserttypeconv(right,u32inttype);
  1058. { when one of the operand is signed or the operation is subn then perform
  1059. the operation in 64bit, can't use rd/ld here because there
  1060. could be already typeconvs inserted.
  1061. This is compatible with the code below for other unsigned types (PFV) }
  1062. if is_signed(left.resultdef) or
  1063. is_signed(right.resultdef) or
  1064. (nodetype=subn) then
  1065. begin
  1066. if nodetype<>subn then
  1067. CGMessage(type_w_mixed_signed_unsigned);
  1068. { mark as internal in case added for a subn, so }
  1069. { ttypeconvnode.simplify can remove the 64 bit }
  1070. { typecast again if semantically correct. Even }
  1071. { if we could detect that here already, we }
  1072. { mustn't do it here because that would change }
  1073. { overload choosing behaviour etc. The code in }
  1074. { ncnv.pas is run after that is already decided }
  1075. if (not is_signed(left.resultdef) and
  1076. not is_signed(right.resultdef)) or
  1077. (nodetype in [orn,xorn]) then
  1078. include(flags,nf_internal);
  1079. inserttypeconv(left,s64inttype);
  1080. inserttypeconv(right,s64inttype);
  1081. end
  1082. else
  1083. begin
  1084. if (torddef(left.resultdef).ordtype<>u32bit) then
  1085. inserttypeconv(left,u32inttype);
  1086. if (torddef(right.resultdef).ordtype<>u32bit) then
  1087. inserttypeconv(right,u32inttype);
  1088. end;
  1089. end
  1090. {$endif cpu64bitaddr}
  1091. { generic ord conversion is sinttype }
  1092. else
  1093. begin
  1094. { if the left or right value is smaller than the normal
  1095. type sinttype and is unsigned, and the other value
  1096. is a constant < 0, the result will always be false/true
  1097. for equal / unequal nodes.
  1098. }
  1099. if (
  1100. { left : unsigned ordinal var, right : < 0 constant }
  1101. (
  1102. ((is_signed(ld)=false) and (is_constintnode(left) =false)) and
  1103. ((is_constintnode(right)) and (tordconstnode(right).value < 0))
  1104. ) or
  1105. { right : unsigned ordinal var, left : < 0 constant }
  1106. (
  1107. ((is_signed(rd)=false) and (is_constintnode(right) =false)) and
  1108. ((is_constintnode(left)) and (tordconstnode(left).value < 0))
  1109. )
  1110. ) then
  1111. begin
  1112. if nodetype = equaln then
  1113. CGMessage(type_w_signed_unsigned_always_false)
  1114. else
  1115. if nodetype = unequaln then
  1116. CGMessage(type_w_signed_unsigned_always_true)
  1117. else
  1118. if (is_constintnode(left) and (nodetype in [ltn,lten])) or
  1119. (is_constintnode(right) and (nodetype in [gtn,gten])) then
  1120. CGMessage(type_w_signed_unsigned_always_true)
  1121. else
  1122. if (is_constintnode(right) and (nodetype in [ltn,lten])) or
  1123. (is_constintnode(left) and (nodetype in [gtn,gten])) then
  1124. CGMessage(type_w_signed_unsigned_always_false);
  1125. end;
  1126. { When there is a signed type or there is a minus operation
  1127. we convert to signed int. Otherwise (both are unsigned) we keep
  1128. the result also unsigned. This is compatible with Delphi (PFV) }
  1129. if is_signed(ld) or
  1130. is_signed(rd) or
  1131. (nodetype=subn) then
  1132. begin
  1133. {$ifdef cpunodefaultint}
  1134. { for small cpus we use the smallest common type }
  1135. llow:=torddef(rd).low;
  1136. if llow<torddef(ld).low then
  1137. llow:=torddef(ld).low;
  1138. lhigh:=torddef(rd).high;
  1139. if lhigh<torddef(ld).high then
  1140. lhigh:=torddef(ld).high;
  1141. case range_to_basetype(llow,lhigh) of
  1142. s8bit:
  1143. nd:=s8inttype;
  1144. u8bit:
  1145. nd:=u8inttype;
  1146. s16bit:
  1147. nd:=s16inttype;
  1148. u16bit:
  1149. nd:=u16inttype;
  1150. s32bit:
  1151. nd:=s32inttype;
  1152. u32bit:
  1153. nd:=u32inttype;
  1154. s64bit:
  1155. nd:=s64inttype;
  1156. u64bit:
  1157. nd:=u64inttype;
  1158. else
  1159. internalerror(200802291);
  1160. end;
  1161. inserttypeconv(right,nd);
  1162. inserttypeconv(left,nd);
  1163. {$else cpunodefaultint}
  1164. inserttypeconv(right,sinttype);
  1165. inserttypeconv(left,sinttype);
  1166. {$endif cpunodefaultint}
  1167. end
  1168. else
  1169. begin
  1170. inserttypeconv(right,uinttype);
  1171. inserttypeconv(left,uinttype);
  1172. end;
  1173. end;
  1174. end
  1175. { if both are floatdefs, conversion is already done before constant folding }
  1176. else if (ld.typ=floatdef) then
  1177. begin
  1178. if not(nodetype in [addn,subn,muln,slashn,equaln,unequaln,ltn,lten,gtn,gten]) then
  1179. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1180. end
  1181. { left side a setdef, must be before string processing,
  1182. else array constructor can be seen as array of char (PFV) }
  1183. else if (ld.typ=setdef) then
  1184. begin
  1185. if not(nodetype in [addn,subn,symdifn,muln,equaln,unequaln,lten,gten]) then
  1186. CGMessage(type_e_set_operation_unknown);
  1187. { right must either be a set or a set element }
  1188. if (rd.typ<>setdef) and
  1189. (rt<>setelementn) then
  1190. CGMessage(type_e_mismatch)
  1191. { Make operands the same setdef. If one's elementtype fits }
  1192. { entirely inside the other's, pick the one with the largest }
  1193. { range. Otherwise create a new setdef with a range which }
  1194. { can contain both. }
  1195. else if not(equal_defs(ld,rd)) then
  1196. begin
  1197. { note: ld cannot be an empty set with elementdef=nil in }
  1198. { case right is not a set, arrayconstructor_to_set takes }
  1199. { care of that }
  1200. { 1: rd is a set with an assigned elementdef, and ld is }
  1201. { either an empty set without elementdef or a set whose }
  1202. { elementdef fits in rd's elementdef -> convert to rd }
  1203. if ((rd.typ=setdef) and
  1204. assigned(tsetdef(rd).elementdef) and
  1205. (not assigned(tsetdef(ld).elementdef) or
  1206. is_in_limit(ld,rd))) then
  1207. inserttypeconv(left,rd)
  1208. { 2: rd is either an empty set without elementdef or a set }
  1209. { whose elementdef fits in ld's elementdef, or a set }
  1210. { element whose def fits in ld's elementdef -> convert }
  1211. { to ld. ld's elementdef can't be nil here, is caught }
  1212. { previous case and "note:" above }
  1213. else if ((rd.typ=setdef) and
  1214. (not assigned(tsetdef(rd).elementdef) or
  1215. is_in_limit(rd,ld))) or
  1216. ((rd.typ<>setdef) and
  1217. is_in_limit(rd,tsetdef(ld).elementdef)) then
  1218. if (rd.typ=setdef) then
  1219. inserttypeconv(right,ld)
  1220. else
  1221. inserttypeconv(right,tsetdef(ld).elementdef)
  1222. { 3: otherwise create setdef which encompasses both, taking }
  1223. { into account empty sets without elementdef }
  1224. else
  1225. begin
  1226. if assigned(tsetdef(ld).elementdef) then
  1227. begin
  1228. llow:=tsetdef(ld).setbase;
  1229. lhigh:=tsetdef(ld).setmax;
  1230. end;
  1231. if (rd.typ=setdef) then
  1232. if assigned(tsetdef(rd).elementdef) then
  1233. begin
  1234. rlow:=tsetdef(rd).setbase;
  1235. rhigh:=tsetdef(rd).setmax;
  1236. end
  1237. else
  1238. begin
  1239. { ld's elementdef must have been valid }
  1240. rlow:=llow;
  1241. rhigh:=lhigh;
  1242. end
  1243. else
  1244. getrange(rd,rlow,rhigh);
  1245. if not assigned(tsetdef(ld).elementdef) then
  1246. begin
  1247. llow:=rlow;
  1248. lhigh:=rhigh;
  1249. end;
  1250. nd:=tsetdef.create(tsetdef(ld).elementdef,min(llow,rlow),max(lhigh,rhigh));
  1251. inserttypeconv(left,nd);
  1252. if (rd.typ=setdef) then
  1253. inserttypeconv(right,nd)
  1254. else
  1255. inserttypeconv(right,tsetdef(nd).elementdef);
  1256. end;
  1257. end;
  1258. end
  1259. { pointer comparision and subtraction }
  1260. else if (
  1261. (rd.typ=pointerdef) and (ld.typ=pointerdef)
  1262. ) or
  1263. { compare/add pchar to variable (not stringconst) char arrays
  1264. by addresses like BP/Delphi }
  1265. (
  1266. (nodetype in [equaln,unequaln,subn,addn]) and
  1267. (
  1268. ((is_pchar(ld) or (lt=niln)) and is_chararray(rd) and (rt<>stringconstn)) or
  1269. ((is_pchar(rd) or (rt=niln)) and is_chararray(ld) and (lt<>stringconstn))
  1270. )
  1271. ) then
  1272. begin
  1273. { convert char array to pointer }
  1274. if is_chararray(rd) then
  1275. begin
  1276. inserttypeconv(right,charpointertype);
  1277. rd:=right.resultdef;
  1278. end
  1279. else if is_chararray(ld) then
  1280. begin
  1281. inserttypeconv(left,charpointertype);
  1282. ld:=left.resultdef;
  1283. end;
  1284. case nodetype of
  1285. equaln,unequaln :
  1286. begin
  1287. if is_voidpointer(right.resultdef) then
  1288. inserttypeconv(right,left.resultdef)
  1289. else if is_voidpointer(left.resultdef) then
  1290. inserttypeconv(left,right.resultdef)
  1291. else if not(equal_defs(ld,rd)) then
  1292. IncompatibleTypes(ld,rd);
  1293. { now that the type checking is done, convert both to charpointer, }
  1294. { because methodpointers are 8 bytes even though only the first 4 }
  1295. { bytes must be compared. This can happen here if we are in }
  1296. { TP/Delphi mode, because there @methodpointer = voidpointer (but }
  1297. { a voidpointer of 8 bytes). A conversion to voidpointer would be }
  1298. { optimized away, since the result already was a voidpointer, so }
  1299. { use a charpointer instead (JM) }
  1300. inserttypeconv_internal(left,charpointertype);
  1301. inserttypeconv_internal(right,charpointertype);
  1302. end;
  1303. ltn,lten,gtn,gten:
  1304. begin
  1305. if (cs_extsyntax in current_settings.moduleswitches) then
  1306. begin
  1307. if is_voidpointer(right.resultdef) then
  1308. inserttypeconv(right,left.resultdef)
  1309. else if is_voidpointer(left.resultdef) then
  1310. inserttypeconv(left,right.resultdef)
  1311. else if not(equal_defs(ld,rd)) then
  1312. IncompatibleTypes(ld,rd);
  1313. end
  1314. else
  1315. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1316. end;
  1317. subn:
  1318. begin
  1319. if (cs_extsyntax in current_settings.moduleswitches) then
  1320. begin
  1321. if is_voidpointer(right.resultdef) then
  1322. begin
  1323. if is_big_untyped_addrnode(right) then
  1324. CGMessage1(type_w_untyped_arithmetic_unportable,node2opstr(nodetype));
  1325. inserttypeconv(right,left.resultdef)
  1326. end
  1327. else if is_voidpointer(left.resultdef) then
  1328. inserttypeconv(left,right.resultdef)
  1329. else if not(equal_defs(ld,rd)) then
  1330. IncompatibleTypes(ld,rd);
  1331. end
  1332. else
  1333. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1334. if not(nf_has_pointerdiv in flags) and
  1335. (tpointerdef(rd).pointeddef.size>1) then
  1336. begin
  1337. hp:=getcopy;
  1338. include(hp.flags,nf_has_pointerdiv);
  1339. result:=cmoddivnode.create(divn,hp,cordconstnode.create(tpointerdef(rd).pointeddef.size,sinttype,false));
  1340. end;
  1341. resultdef:=sinttype;
  1342. exit;
  1343. end;
  1344. else
  1345. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1346. end;
  1347. end
  1348. { is one of the operands a string?,
  1349. chararrays are also handled as strings (after conversion), also take
  1350. care of chararray+chararray and chararray+char.
  1351. Note: Must be done after pointerdef+pointerdef has been checked, else
  1352. pchar is converted to string }
  1353. else if (rd.typ=stringdef) or
  1354. (ld.typ=stringdef) or
  1355. { stringconstn's can be arraydefs }
  1356. (lt=stringconstn) or
  1357. (rt=stringconstn) or
  1358. ((is_pchar(rd) or is_chararray(rd) or is_char(rd) or is_open_chararray(rd) or
  1359. is_pwidechar(rd) or is_widechararray(rd) or is_widechar(rd) or is_open_widechararray(rd)) and
  1360. (is_pchar(ld) or is_chararray(ld) or is_char(ld) or is_open_chararray(ld) or
  1361. is_pwidechar(ld) or is_widechararray(ld) or is_widechar(ld) or is_open_widechararray(ld))) then
  1362. begin
  1363. if (nodetype in [addn,equaln,unequaln,lten,gten,ltn,gtn]) then
  1364. begin
  1365. { Is there a unicodestring? }
  1366. if is_unicodestring(rd) or is_unicodestring(ld) then
  1367. strtype:= st_unicodestring
  1368. else
  1369. { Is there a widestring? }
  1370. if is_widestring(rd) or is_widestring(ld) or
  1371. is_unicodestring(rd) or is_unicodestring(ld) or
  1372. is_pwidechar(rd) or is_widechararray(rd) or is_widechar(rd) or is_open_widechararray(rd) or
  1373. is_pwidechar(ld) or is_widechararray(ld) or is_widechar(ld) or is_open_widechararray(ld) then
  1374. strtype:= st_widestring
  1375. else
  1376. if is_ansistring(rd) or is_ansistring(ld) or
  1377. ((cs_ansistrings in current_settings.localswitches) and
  1378. //todo: Move some of this to longstring's then they are implemented?
  1379. (
  1380. is_pchar(rd) or (is_chararray(rd) and (rd.size > 255)) or is_open_chararray(rd) or
  1381. is_pchar(ld) or (is_chararray(ld) and (ld.size > 255)) or is_open_chararray(ld)
  1382. )
  1383. ) then
  1384. strtype:= st_ansistring
  1385. else
  1386. if is_longstring(rd) or is_longstring(ld) then
  1387. strtype:= st_longstring
  1388. else
  1389. begin
  1390. { TODO: todo: add a warning/hint here if one converting a too large array}
  1391. { nodes is PChar, array [with size > 255] or OpenArrayOfChar.
  1392. Note: Delphi halts with error if "array [0..xx] of char"
  1393. is assigned to ShortString and string length is less
  1394. then array size }
  1395. strtype:= st_shortstring;
  1396. end;
  1397. // Now convert nodes to common string type
  1398. case strtype of
  1399. st_widestring :
  1400. begin
  1401. if not(is_widestring(rd)) then
  1402. inserttypeconv(right,cwidestringtype);
  1403. if not(is_widestring(ld)) then
  1404. inserttypeconv(left,cwidestringtype);
  1405. end;
  1406. st_unicodestring :
  1407. begin
  1408. if not(is_unicodestring(rd)) then
  1409. inserttypeconv(right,cunicodestringtype);
  1410. if not(is_unicodestring(ld)) then
  1411. inserttypeconv(left,cunicodestringtype);
  1412. end;
  1413. st_ansistring :
  1414. begin
  1415. if not(is_ansistring(rd)) then
  1416. inserttypeconv(right,cansistringtype);
  1417. if not(is_ansistring(ld)) then
  1418. inserttypeconv(left,cansistringtype);
  1419. end;
  1420. st_longstring :
  1421. begin
  1422. if not(is_longstring(rd)) then
  1423. inserttypeconv(right,clongstringtype);
  1424. if not(is_longstring(ld)) then
  1425. inserttypeconv(left,clongstringtype);
  1426. end;
  1427. st_shortstring :
  1428. begin
  1429. if not(is_shortstring(ld)) then
  1430. inserttypeconv(left,cshortstringtype);
  1431. { don't convert char, that can be handled by the optimized node }
  1432. if not(is_shortstring(rd) or is_char(rd)) then
  1433. inserttypeconv(right,cshortstringtype);
  1434. end;
  1435. else
  1436. internalerror(2005101);
  1437. end;
  1438. end
  1439. else
  1440. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1441. end
  1442. { class or interface equation }
  1443. else if is_class_or_interface(rd) or is_class_or_interface(ld) then
  1444. begin
  1445. if (nodetype in [equaln,unequaln]) then
  1446. begin
  1447. if is_class_or_interface(rd) and is_class_or_interface(ld) then
  1448. begin
  1449. if tobjectdef(rd).is_related(tobjectdef(ld)) then
  1450. inserttypeconv(right,left.resultdef)
  1451. else
  1452. inserttypeconv(left,right.resultdef);
  1453. end
  1454. else if is_class_or_interface(rd) then
  1455. inserttypeconv(left,right.resultdef)
  1456. else
  1457. inserttypeconv(right,left.resultdef);
  1458. end
  1459. else
  1460. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1461. end
  1462. else if (rd.typ=classrefdef) and (ld.typ=classrefdef) then
  1463. begin
  1464. if (nodetype in [equaln,unequaln]) then
  1465. begin
  1466. if tobjectdef(tclassrefdef(rd).pointeddef).is_related(
  1467. tobjectdef(tclassrefdef(ld).pointeddef)) then
  1468. inserttypeconv(right,left.resultdef)
  1469. else
  1470. inserttypeconv(left,right.resultdef);
  1471. end
  1472. else
  1473. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1474. end
  1475. { allows comperasion with nil pointer }
  1476. else if is_class_or_interface(rd) or (rd.typ=classrefdef) then
  1477. begin
  1478. if (nodetype in [equaln,unequaln]) then
  1479. inserttypeconv(left,right.resultdef)
  1480. else
  1481. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1482. end
  1483. else if is_class_or_interface(ld) or (ld.typ=classrefdef) then
  1484. begin
  1485. if (nodetype in [equaln,unequaln]) then
  1486. inserttypeconv(right,left.resultdef)
  1487. else
  1488. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1489. end
  1490. { support procvar=nil,procvar<>nil }
  1491. else if ((ld.typ=procvardef) and (rt=niln)) or
  1492. ((rd.typ=procvardef) and (lt=niln)) then
  1493. begin
  1494. if not(nodetype in [equaln,unequaln]) then
  1495. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1496. { find proc field in methodpointer record }
  1497. hsym:=tfieldvarsym(trecorddef(methodpointertype).symtable.Find('proc'));
  1498. if not assigned(hsym) then
  1499. internalerror(200412043);
  1500. { For methodpointers compare only tmethodpointer.proc }
  1501. if (rd.typ=procvardef) and
  1502. (not tprocvardef(rd).is_addressonly) then
  1503. begin
  1504. right:=csubscriptnode.create(
  1505. hsym,
  1506. ctypeconvnode.create_internal(right,methodpointertype));
  1507. typecheckpass(right);
  1508. end;
  1509. if (ld.typ=procvardef) and
  1510. (not tprocvardef(ld).is_addressonly) then
  1511. begin
  1512. left:=csubscriptnode.create(
  1513. hsym,
  1514. ctypeconvnode.create_internal(left,methodpointertype));
  1515. typecheckpass(left);
  1516. end;
  1517. end
  1518. { support dynamicarray=nil,dynamicarray<>nil }
  1519. else if (is_dynamic_array(ld) and (rt=niln)) or
  1520. (is_dynamic_array(rd) and (lt=niln)) or
  1521. (is_dynamic_array(ld) and is_dynamic_array(rd)) then
  1522. begin
  1523. if not(nodetype in [equaln,unequaln]) then
  1524. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1525. end
  1526. {$ifdef SUPPORT_MMX}
  1527. { mmx support, this must be before the zero based array
  1528. check }
  1529. else if (cs_mmx in current_settings.localswitches) and
  1530. is_mmx_able_array(ld) and
  1531. is_mmx_able_array(rd) and
  1532. equal_defs(ld,rd) then
  1533. begin
  1534. case nodetype of
  1535. addn,subn,xorn,orn,andn:
  1536. ;
  1537. { mul is a little bit restricted }
  1538. muln:
  1539. if not(mmx_type(ld) in [mmxu16bit,mmxs16bit,mmxfixed16]) then
  1540. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1541. else
  1542. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1543. end;
  1544. end
  1545. {$endif SUPPORT_MMX}
  1546. { vector support, this must be before the zero based array
  1547. check }
  1548. else if (cs_support_vectors in current_settings.globalswitches) and
  1549. is_vector(ld) and
  1550. is_vector(rd) and
  1551. equal_defs(ld,rd) then
  1552. begin
  1553. if not(nodetype in [addn,subn,xorn,orn,andn,muln,slashn]) then
  1554. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1555. { both defs must be equal, so taking left or right as resultdef doesn't matter }
  1556. resultdef:=left.resultdef;
  1557. end
  1558. { this is a little bit dangerous, also the left type }
  1559. { pointer to should be checked! This broke the mmx support }
  1560. else if (rd.typ=pointerdef) or
  1561. (is_zero_based_array(rd) and (rt<>stringconstn)) then
  1562. begin
  1563. if is_zero_based_array(rd) then
  1564. begin
  1565. resultdef:=tpointerdef.create(tarraydef(rd).elementdef);
  1566. inserttypeconv(right,resultdef);
  1567. end
  1568. else
  1569. resultdef:=right.resultdef;
  1570. inserttypeconv(left,sinttype);
  1571. if nodetype=addn then
  1572. begin
  1573. if not(cs_extsyntax in current_settings.moduleswitches) or
  1574. (not(is_pchar(ld)) and not(m_add_pointer in current_settings.modeswitches)) then
  1575. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1576. if (rd.typ=pointerdef) and
  1577. (tpointerdef(rd).pointeddef.size>1) then
  1578. begin
  1579. left:=caddnode.create(muln,left,
  1580. cordconstnode.create(tpointerdef(rd).pointeddef.size,sinttype,true));
  1581. typecheckpass(left);
  1582. end;
  1583. end
  1584. else
  1585. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1586. end
  1587. else if (ld.typ=pointerdef) or
  1588. (is_zero_based_array(ld) and (lt<>stringconstn)) then
  1589. begin
  1590. if is_zero_based_array(ld) then
  1591. begin
  1592. resultdef:=tpointerdef.create(tarraydef(ld).elementdef);
  1593. inserttypeconv(left,resultdef);
  1594. end
  1595. else
  1596. resultdef:=left.resultdef;
  1597. inserttypeconv(right,sinttype);
  1598. if nodetype in [addn,subn] then
  1599. begin
  1600. if not(cs_extsyntax in current_settings.moduleswitches) or
  1601. (not(is_pchar(ld)) and not(m_add_pointer in current_settings.modeswitches)) then
  1602. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1603. if (ld.typ=pointerdef) then
  1604. begin
  1605. if is_big_untyped_addrnode(left) then
  1606. CGMessage1(type_w_untyped_arithmetic_unportable,node2opstr(nodetype));
  1607. if (tpointerdef(ld).pointeddef.size>1) then
  1608. begin
  1609. right:=caddnode.create(muln,right,
  1610. cordconstnode.create(tpointerdef(ld).pointeddef.size,sinttype,true));
  1611. typecheckpass(right);
  1612. end
  1613. end else
  1614. if is_zero_based_array(ld) and
  1615. (tarraydef(ld).elementdef.size>1) then
  1616. begin
  1617. right:=caddnode.create(muln,right,
  1618. cordconstnode.create(tarraydef(ld).elementdef.size,sinttype,true));
  1619. typecheckpass(right);
  1620. end;
  1621. end
  1622. else
  1623. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1624. end
  1625. else if (rd.typ=procvardef) and
  1626. (ld.typ=procvardef) and
  1627. equal_defs(rd,ld) then
  1628. begin
  1629. if (nodetype in [equaln,unequaln]) then
  1630. begin
  1631. if tprocvardef(rd).is_addressonly then
  1632. begin
  1633. inserttypeconv_internal(right,voidpointertype);
  1634. inserttypeconv_internal(left,voidpointertype);
  1635. end
  1636. else
  1637. begin
  1638. { find proc field in methodpointer record }
  1639. hsym:=tfieldvarsym(trecorddef(methodpointertype).symtable.Find('proc'));
  1640. if not assigned(hsym) then
  1641. internalerror(200412043);
  1642. { Compare tmehodpointer(left).proc }
  1643. right:=csubscriptnode.create(
  1644. hsym,
  1645. ctypeconvnode.create_internal(right,methodpointertype));
  1646. typecheckpass(right);
  1647. left:=csubscriptnode.create(
  1648. hsym,
  1649. ctypeconvnode.create_internal(left,methodpointertype));
  1650. typecheckpass(left);
  1651. end;
  1652. end
  1653. else
  1654. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1655. end
  1656. { enums }
  1657. else if (ld.typ=enumdef) and (rd.typ=enumdef) then
  1658. begin
  1659. if allowenumop(nodetype) then
  1660. inserttypeconv(right,left.resultdef)
  1661. else
  1662. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1663. end
  1664. { generic conversion, this is for error recovery }
  1665. else
  1666. begin
  1667. inserttypeconv(left,sinttype);
  1668. inserttypeconv(right,sinttype);
  1669. end;
  1670. { set resultdef if not already done }
  1671. if not assigned(resultdef) then
  1672. begin
  1673. case nodetype of
  1674. ltn,lten,gtn,gten,equaln,unequaln :
  1675. resultdef:=booltype;
  1676. slashn :
  1677. resultdef:=resultrealdef;
  1678. addn:
  1679. begin
  1680. { for strings, return is always a 255 char string }
  1681. if is_shortstring(left.resultdef) then
  1682. resultdef:=cshortstringtype
  1683. else
  1684. resultdef:=left.resultdef;
  1685. end;
  1686. else
  1687. resultdef:=left.resultdef;
  1688. end;
  1689. end;
  1690. { when the result is currency we need some extra code for
  1691. multiplication and division. this should not be done when
  1692. the muln or slashn node is created internally }
  1693. if not(nf_is_currency in flags) and
  1694. is_currency(resultdef) then
  1695. begin
  1696. case nodetype of
  1697. slashn :
  1698. begin
  1699. { slashn will only work with floats }
  1700. hp:=caddnode.create(muln,getcopy,crealconstnode.create(10000.0,s64currencytype));
  1701. include(hp.flags,nf_is_currency);
  1702. result:=hp;
  1703. end;
  1704. muln :
  1705. begin
  1706. if s64currencytype.typ=floatdef then
  1707. hp:=caddnode.create(slashn,getcopy,crealconstnode.create(10000.0,s64currencytype))
  1708. else
  1709. hp:=cmoddivnode.create(divn,getcopy,cordconstnode.create(10000,s64currencytype,false));
  1710. include(hp.flags,nf_is_currency);
  1711. result:=hp
  1712. end;
  1713. end;
  1714. end;
  1715. if not codegenerror and
  1716. not assigned(result) then
  1717. result:=simplify;
  1718. end;
  1719. function taddnode.first_addstring: tnode;
  1720. const
  1721. swap_relation: array [ltn..unequaln] of Tnodetype=(gtn, gten, ltn, lten, equaln, unequaln);
  1722. var
  1723. p: tnode;
  1724. newstatement : tstatementnode;
  1725. tempnode (*,tempnode2*) : ttempcreatenode;
  1726. cmpfuncname: string;
  1727. begin
  1728. { when we get here, we are sure that both the left and the right }
  1729. { node are both strings of the same stringtype (JM) }
  1730. case nodetype of
  1731. addn:
  1732. begin
  1733. if (left.nodetype=stringconstn) and (tstringconstnode(left).len=0) then
  1734. begin
  1735. result:=right;
  1736. left.free;
  1737. left:=nil;
  1738. right:=nil;
  1739. exit;
  1740. end;
  1741. if (right.nodetype=stringconstn) and (tstringconstnode(right).len=0) then
  1742. begin
  1743. result:=left;
  1744. left:=nil;
  1745. right.free;
  1746. right:=nil;
  1747. exit;
  1748. end;
  1749. { create the call to the concat routine both strings as arguments }
  1750. if assigned(aktassignmentnode) and
  1751. (aktassignmentnode.right=self) and
  1752. (aktassignmentnode.left.resultdef=resultdef) and
  1753. valid_for_var(aktassignmentnode.left,false) then
  1754. begin
  1755. result:=ccallnode.createintern('fpc_'+
  1756. tstringdef(resultdef).stringtypname+'_concat',
  1757. ccallparanode.create(right,
  1758. ccallparanode.create(left,
  1759. ccallparanode.create(aktassignmentnode.left.getcopy,nil))));
  1760. include(aktassignmentnode.flags,nf_assign_done_in_right);
  1761. firstpass(result);
  1762. end
  1763. else
  1764. begin
  1765. result:=internalstatements(newstatement);
  1766. tempnode:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true);
  1767. addstatement(newstatement,tempnode);
  1768. addstatement(newstatement,ccallnode.createintern('fpc_'+
  1769. tstringdef(resultdef).stringtypname+'_concat',
  1770. ccallparanode.create(right,
  1771. ccallparanode.create(left,
  1772. ccallparanode.create(ctemprefnode.create(tempnode),nil)))));
  1773. addstatement(newstatement,ctempdeletenode.create_normal_temp(tempnode));
  1774. addstatement(newstatement,ctemprefnode.create(tempnode));
  1775. end;
  1776. { we reused the arguments }
  1777. left := nil;
  1778. right := nil;
  1779. end;
  1780. ltn,lten,gtn,gten,equaln,unequaln :
  1781. begin
  1782. { generate better code for comparison with empty string, we
  1783. only need to compare the length with 0 }
  1784. if (nodetype in [equaln,unequaln,gtn,gten,ltn,lten]) and
  1785. { windows widestrings are too complicated to be handled optimized }
  1786. not(is_widestring(left.resultdef) and (target_info.system in system_windows)) and
  1787. (((left.nodetype=stringconstn) and (tstringconstnode(left).len=0)) or
  1788. ((right.nodetype=stringconstn) and (tstringconstnode(right).len=0))) then
  1789. begin
  1790. { switch so that the constant is always on the right }
  1791. if left.nodetype = stringconstn then
  1792. begin
  1793. p := left;
  1794. left := right;
  1795. right := p;
  1796. nodetype:=swap_relation[nodetype];
  1797. end;
  1798. if is_shortstring(left.resultdef) or
  1799. (nodetype in [gtn,gten,ltn,lten]) then
  1800. { compare the length with 0 }
  1801. result := caddnode.create(nodetype,
  1802. cinlinenode.create(in_length_x,false,left),
  1803. cordconstnode.create(0,s32inttype,false))
  1804. else
  1805. begin
  1806. (*
  1807. if is_widestring(left.resultdef) and
  1808. (target_info.system in system_windows) then
  1809. begin
  1810. { windows like widestrings requires that we also check the length }
  1811. result:=internalstatements(newstatement);
  1812. tempnode:=ctempcreatenode.create(voidpointertype,voidpointertype.size,tt_persistent,true);
  1813. tempnode2:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true);
  1814. addstatement(newstatement,tempnode);
  1815. addstatement(newstatement,tempnode2);
  1816. { poor man's cse }
  1817. addstatement(newstatement,cassignmentnode.create(ctemprefnode.create(tempnode),
  1818. ctypeconvnode.create_internal(left,voidpointertype))
  1819. );
  1820. addstatement(newstatement,cassignmentnode.create(ctemprefnode.create(tempnode2),
  1821. caddnode.create(orn,
  1822. caddnode.create(nodetype,
  1823. ctemprefnode.create(tempnode),
  1824. cpointerconstnode.create(0,voidpointertype)
  1825. ),
  1826. caddnode.create(nodetype,
  1827. ctypeconvnode.create_internal(cderefnode.create(ctemprefnode.create(tempnode)),s32inttype),
  1828. cordconstnode.create(0,s32inttype,false)
  1829. )
  1830. )
  1831. ));
  1832. addstatement(newstatement,ctempdeletenode.create_normal_temp(tempnode));
  1833. addstatement(newstatement,ctempdeletenode.create_normal_temp(tempnode2));
  1834. addstatement(newstatement,ctemprefnode.create(tempnode2));
  1835. end
  1836. else
  1837. *)
  1838. begin
  1839. { compare the pointer with nil (for ansistrings etc), }
  1840. { faster than getting the length (JM) }
  1841. result:= caddnode.create(nodetype,
  1842. ctypeconvnode.create_internal(left,voidpointertype),
  1843. cpointerconstnode.create(0,voidpointertype));
  1844. end;
  1845. end;
  1846. { left is reused }
  1847. left := nil;
  1848. { right isn't }
  1849. right.free;
  1850. right := nil;
  1851. exit;
  1852. end;
  1853. { no string constant -> call compare routine }
  1854. cmpfuncname := 'fpc_'+tstringdef(left.resultdef).stringtypname+'_compare';
  1855. { for equality checks use optimized version }
  1856. if nodetype in [equaln,unequaln] then
  1857. cmpfuncname := cmpfuncname + '_equal';
  1858. result := ccallnode.createintern(cmpfuncname,
  1859. ccallparanode.create(right,ccallparanode.create(left,nil)));
  1860. { and compare its result with 0 according to the original operator }
  1861. result := caddnode.create(nodetype,result,
  1862. cordconstnode.create(0,s32inttype,false));
  1863. left := nil;
  1864. right := nil;
  1865. end;
  1866. end;
  1867. end;
  1868. function taddnode.first_addset : tnode;
  1869. procedure call_varset_helper(const n : string);
  1870. var
  1871. newstatement : tstatementnode;
  1872. temp : ttempcreatenode;
  1873. begin
  1874. { add two var sets }
  1875. result:=internalstatements(newstatement);
  1876. { create temp for result }
  1877. temp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true);
  1878. addstatement(newstatement,temp);
  1879. addstatement(newstatement,ccallnode.createintern(n,
  1880. ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false),
  1881. ccallparanode.create(ctemprefnode.create(temp),
  1882. ccallparanode.create(right,
  1883. ccallparanode.create(left,nil)))))
  1884. );
  1885. { remove reused parts from original node }
  1886. left:=nil;
  1887. right:=nil;
  1888. { the last statement should return the value as
  1889. location and type, this is done be referencing the
  1890. temp and converting it first from a persistent temp to
  1891. normal temp }
  1892. addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
  1893. addstatement(newstatement,ctemprefnode.create(temp));
  1894. end;
  1895. var
  1896. procname: string[31];
  1897. tempn: tnode;
  1898. newstatement : tstatementnode;
  1899. temp : ttempcreatenode;
  1900. begin
  1901. result:=nil;
  1902. case nodetype of
  1903. equaln,unequaln,lten,gten:
  1904. begin
  1905. case nodetype of
  1906. equaln,unequaln:
  1907. procname := 'fpc_varset_comp_sets';
  1908. lten,gten:
  1909. begin
  1910. procname := 'fpc_varset_contains_sets';
  1911. { (left >= right) = (right <= left) }
  1912. if nodetype = gten then
  1913. begin
  1914. tempn := left;
  1915. left := right;
  1916. right := tempn;
  1917. end;
  1918. end;
  1919. end;
  1920. result := ccallnode.createinternres(procname,
  1921. ccallparanode.create(cordconstnode.create(left.resultdef.size,sinttype,false),
  1922. ccallparanode.create(right,
  1923. ccallparanode.create(left,nil))),resultdef);
  1924. { left and right are reused as parameters }
  1925. left := nil;
  1926. right := nil;
  1927. { for an unequaln, we have to negate the result of comp_sets }
  1928. if nodetype = unequaln then
  1929. result := cnotnode.create(result);
  1930. end;
  1931. addn:
  1932. begin
  1933. { optimize first loading of a set }
  1934. if (right.nodetype=setelementn) and
  1935. not(assigned(tsetelementnode(right).right)) and
  1936. is_emptyset(left) then
  1937. begin
  1938. result:=internalstatements(newstatement);
  1939. { create temp for result }
  1940. temp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true);
  1941. addstatement(newstatement,temp);
  1942. { adjust for set base }
  1943. tsetelementnode(right).left:=caddnode.create(subn,
  1944. ctypeconvnode.create_internal(tsetelementnode(right).left,sinttype),
  1945. cordconstnode.create(tsetdef(resultdef).setbase,sinttype,false));
  1946. addstatement(newstatement,ccallnode.createintern('fpc_varset_create_element',
  1947. ccallparanode.create(ctemprefnode.create(temp),
  1948. ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false),
  1949. ccallparanode.create(tsetelementnode(right).left,nil))))
  1950. );
  1951. { the last statement should return the value as
  1952. location and type, this is done be referencing the
  1953. temp and converting it first from a persistent temp to
  1954. normal temp }
  1955. addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
  1956. addstatement(newstatement,ctemprefnode.create(temp));
  1957. tsetelementnode(right).left := nil;
  1958. end
  1959. else
  1960. begin
  1961. if right.nodetype=setelementn then
  1962. begin
  1963. result:=internalstatements(newstatement);
  1964. { create temp for result }
  1965. temp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true);
  1966. addstatement(newstatement,temp);
  1967. { adjust for set base }
  1968. tsetelementnode(right).left:=caddnode.create(subn,
  1969. ctypeconvnode.create_internal(tsetelementnode(right).left,sinttype),
  1970. cordconstnode.create(tsetdef(resultdef).setbase,sinttype,false));
  1971. { add a range or a single element? }
  1972. if assigned(tsetelementnode(right).right) then
  1973. begin
  1974. { adjust for set base }
  1975. tsetelementnode(right).right:=caddnode.create(subn,
  1976. ctypeconvnode.create_internal(tsetelementnode(right).right,sinttype),
  1977. cordconstnode.create(tsetdef(resultdef).setbase,sinttype,false));
  1978. addstatement(newstatement,ccallnode.createintern('fpc_varset_set_range',
  1979. ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false),
  1980. ccallparanode.create(tsetelementnode(right).right,
  1981. ccallparanode.create(tsetelementnode(right).left,
  1982. ccallparanode.create(ctemprefnode.create(temp),
  1983. ccallparanode.create(left,nil))))))
  1984. );
  1985. end
  1986. else
  1987. addstatement(newstatement,ccallnode.createintern('fpc_varset_set',
  1988. ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false),
  1989. ccallparanode.create(ctypeconvnode.create_internal(tsetelementnode(right).left,sinttype),
  1990. ccallparanode.create(ctemprefnode.create(temp),
  1991. ccallparanode.create(left,nil)))))
  1992. );
  1993. { remove reused parts from original node }
  1994. tsetelementnode(right).right:=nil;
  1995. tsetelementnode(right).left:=nil;
  1996. left:=nil;
  1997. { the last statement should return the value as
  1998. location and type, this is done be referencing the
  1999. temp and converting it first from a persistent temp to
  2000. normal temp }
  2001. addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
  2002. addstatement(newstatement,ctemprefnode.create(temp));
  2003. end
  2004. else
  2005. call_varset_helper('fpc_varset_add_sets');
  2006. end
  2007. end;
  2008. subn:
  2009. call_varset_helper('fpc_varset_sub_sets');
  2010. symdifn:
  2011. call_varset_helper('fpc_varset_symdif_sets');
  2012. muln:
  2013. call_varset_helper('fpc_varset_mul_sets');
  2014. else
  2015. internalerror(200609241);
  2016. end;
  2017. end;
  2018. function taddnode.use_generic_mul32to64: boolean;
  2019. begin
  2020. result := true;
  2021. end;
  2022. function taddnode.try_make_mul32to64: boolean;
  2023. function canbe32bitint(v: tconstexprint): boolean;
  2024. begin
  2025. result := ((v >= int64(low(longint))) and (v <= int64(high(longint)))) or
  2026. ((v >= qword(low(cardinal))) and (v <= qword(high(cardinal))))
  2027. end;
  2028. var
  2029. temp: tnode;
  2030. begin
  2031. result := false;
  2032. if ((left.nodetype = typeconvn) and
  2033. is_integer(ttypeconvnode(left).left.resultdef) and
  2034. (not(torddef(ttypeconvnode(left).left.resultdef).ordtype in [u64bit,s64bit])) and
  2035. (((right.nodetype = ordconstn) and canbe32bitint(tordconstnode(right).value)) or
  2036. ((right.nodetype = typeconvn) and
  2037. is_integer(ttypeconvnode(right).left.resultdef) and
  2038. not(torddef(ttypeconvnode(right).left.resultdef).ordtype in [u64bit,s64bit])) and
  2039. ((is_signed(ttypeconvnode(left).left.resultdef) =
  2040. is_signed(ttypeconvnode(right).left.resultdef)) or
  2041. (is_signed(ttypeconvnode(left).left.resultdef) and
  2042. (torddef(ttypeconvnode(right).left.resultdef).ordtype in [u8bit,u16bit]))))) then
  2043. begin
  2044. temp := ttypeconvnode(left).left;
  2045. ttypeconvnode(left).left := nil;
  2046. left.free;
  2047. left := temp;
  2048. if (right.nodetype = typeconvn) then
  2049. begin
  2050. temp := ttypeconvnode(right).left;
  2051. ttypeconvnode(right).left := nil;
  2052. right.free;
  2053. right := temp;
  2054. end;
  2055. if (is_signed(left.resultdef)) then
  2056. begin
  2057. inserttypeconv(left,s32inttype);
  2058. inserttypeconv(right,s32inttype);
  2059. end
  2060. else
  2061. begin
  2062. inserttypeconv(left,u32inttype);
  2063. inserttypeconv(right,u32inttype);
  2064. end;
  2065. firstpass(left);
  2066. firstpass(right);
  2067. result := true;
  2068. end;
  2069. end;
  2070. function taddnode.first_add64bitint: tnode;
  2071. var
  2072. procname: string[31];
  2073. temp: tnode;
  2074. power: longint;
  2075. begin
  2076. result := nil;
  2077. { create helper calls mul }
  2078. if nodetype <> muln then
  2079. exit;
  2080. { make sure that if there is a constant, that it's on the right }
  2081. if left.nodetype = ordconstn then
  2082. begin
  2083. temp := right;
  2084. right := left;
  2085. left := temp;
  2086. end;
  2087. { can we use a shift instead of a mul? }
  2088. if not (cs_check_overflow in current_settings.localswitches) and
  2089. (right.nodetype = ordconstn) and
  2090. ispowerof2(tordconstnode(right).value,power) then
  2091. begin
  2092. tordconstnode(right).value := power;
  2093. result := cshlshrnode.create(shln,left,right);
  2094. { left and right are reused }
  2095. left := nil;
  2096. right := nil;
  2097. { return firstpassed new node }
  2098. exit;
  2099. end;
  2100. if not(use_generic_mul32to64) and
  2101. try_make_mul32to64 then
  2102. exit;
  2103. { when currency is used set the result of the
  2104. parameters to s64bit, so they are not converted }
  2105. if is_currency(resultdef) then
  2106. begin
  2107. left.resultdef:=s64inttype;
  2108. right.resultdef:=s64inttype;
  2109. end;
  2110. { otherwise, create the parameters for the helper }
  2111. right := ccallparanode.create(
  2112. cordconstnode.create(ord(cs_check_overflow in current_settings.localswitches),booltype,true),
  2113. ccallparanode.create(right,ccallparanode.create(left,nil)));
  2114. left := nil;
  2115. { only qword needs the unsigned code, the
  2116. signed code is also used for currency }
  2117. if is_signed(resultdef) then
  2118. procname := 'fpc_mul_int64'
  2119. else
  2120. procname := 'fpc_mul_qword';
  2121. result := ccallnode.createintern(procname,right);
  2122. right := nil;
  2123. end;
  2124. function taddnode.first_addfloat : tnode;
  2125. var
  2126. procname: string[31];
  2127. { do we need to reverse the result ? }
  2128. notnode : boolean;
  2129. fdef : tdef;
  2130. begin
  2131. result := nil;
  2132. notnode := false;
  2133. { In non-emulation mode, real opcodes are
  2134. emitted for floating point values.
  2135. }
  2136. if not (cs_fp_emulation in current_settings.moduleswitches) then
  2137. exit;
  2138. if not(target_info.system in system_wince) then
  2139. begin
  2140. case tfloatdef(left.resultdef).floattype of
  2141. s32real:
  2142. begin
  2143. fdef:=search_system_type('FLOAT32REC').typedef;
  2144. procname:='float32';
  2145. end;
  2146. s64real:
  2147. begin
  2148. fdef:=search_system_type('FLOAT64').typedef;
  2149. procname:='float64';
  2150. end;
  2151. {!!! not yet implemented
  2152. s128real:
  2153. }
  2154. else
  2155. internalerror(2005082601);
  2156. end;
  2157. case nodetype of
  2158. addn:
  2159. procname:=procname+'_add';
  2160. muln:
  2161. procname:=procname+'_mul';
  2162. subn:
  2163. procname:=procname+'_sub';
  2164. slashn:
  2165. procname:=procname+'_div';
  2166. ltn:
  2167. procname:=procname+'_lt';
  2168. lten:
  2169. procname:=procname+'_le';
  2170. gtn:
  2171. begin
  2172. procname:=procname+'_le';
  2173. notnode:=true;
  2174. end;
  2175. gten:
  2176. begin
  2177. procname:=procname+'_lt';
  2178. notnode:=true;
  2179. end;
  2180. equaln:
  2181. procname:=procname+'_eq';
  2182. unequaln:
  2183. begin
  2184. procname:=procname+'_eq';
  2185. notnode:=true;
  2186. end;
  2187. else
  2188. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),left.resultdef.typename,right.resultdef.typename);
  2189. end;
  2190. end
  2191. else
  2192. begin
  2193. case nodetype of
  2194. addn:
  2195. procname:='ADD';
  2196. muln:
  2197. procname:='MUL';
  2198. subn:
  2199. procname:='SUB';
  2200. slashn:
  2201. procname:='DIV';
  2202. ltn:
  2203. procname:='LT';
  2204. lten:
  2205. procname:='LE';
  2206. gtn:
  2207. procname:='GT';
  2208. gten:
  2209. procname:='GE';
  2210. equaln:
  2211. procname:='EQ';
  2212. unequaln:
  2213. procname:='NE';
  2214. else
  2215. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),left.resultdef.typename,right.resultdef.typename);
  2216. end;
  2217. case tfloatdef(left.resultdef).floattype of
  2218. s32real:
  2219. begin
  2220. procname:=procname+'S';
  2221. if nodetype in [addn,muln,subn,slashn] then
  2222. procname:=lower(procname);
  2223. end;
  2224. s64real:
  2225. procname:=procname+'D';
  2226. {!!! not yet implemented
  2227. s128real:
  2228. }
  2229. else
  2230. internalerror(2005082602);
  2231. end;
  2232. end;
  2233. { cast softfpu result? }
  2234. if not(target_info.system in system_wince) then
  2235. begin
  2236. if nodetype in [ltn,lten,gtn,gten,equaln,unequaln] then
  2237. resultdef:=booltype;
  2238. result:=ctypeconvnode.create_internal(ccallnode.createintern(procname,ccallparanode.create(
  2239. ctypeconvnode.create_internal(right,fdef),
  2240. ccallparanode.create(
  2241. ctypeconvnode.create_internal(left,fdef),nil))),resultdef);
  2242. end
  2243. else
  2244. result:=ccallnode.createintern(procname,ccallparanode.create(right,
  2245. ccallparanode.create(left,nil)));
  2246. left:=nil;
  2247. right:=nil;
  2248. { do we need to reverse the result }
  2249. if notnode then
  2250. result:=cnotnode.create(result);
  2251. end;
  2252. function taddnode.pass_1 : tnode;
  2253. var
  2254. {$ifdef addstringopt}
  2255. hp : tnode;
  2256. {$endif addstringopt}
  2257. rd,ld : tdef;
  2258. i : longint;
  2259. lt,rt : tnodetype;
  2260. begin
  2261. result:=nil;
  2262. { Can we optimize multiple string additions into a single call?
  2263. This need to be done on a complete tree to detect the multiple
  2264. add nodes and is therefor done before the subtrees are processed }
  2265. if canbemultistringadd(self) then
  2266. begin
  2267. result := genmultistringadd(self);
  2268. exit;
  2269. end;
  2270. { first do the two subtrees }
  2271. firstpass(left);
  2272. firstpass(right);
  2273. if codegenerror then
  2274. exit;
  2275. { load easier access variables }
  2276. rd:=right.resultdef;
  2277. ld:=left.resultdef;
  2278. rt:=right.nodetype;
  2279. lt:=left.nodetype;
  2280. { int/int gives real/real! }
  2281. if nodetype=slashn then
  2282. begin
  2283. {$ifdef cpufpemu}
  2284. if (current_settings.fputype=fpu_soft) or (cs_fp_emulation in current_settings.moduleswitches) then
  2285. begin
  2286. result:=first_addfloat;
  2287. if assigned(result) then
  2288. exit;
  2289. end;
  2290. {$endif cpufpemu}
  2291. expectloc:=LOC_FPUREGISTER;
  2292. end
  2293. { if both are orddefs then check sub types }
  2294. else if (ld.typ=orddef) and (rd.typ=orddef) then
  2295. begin
  2296. { optimize multiplacation by a power of 2 }
  2297. if not(cs_check_overflow in current_settings.localswitches) and
  2298. (nodetype = muln) and
  2299. (((left.nodetype = ordconstn) and
  2300. ispowerof2(tordconstnode(left).value,i)) or
  2301. ((right.nodetype = ordconstn) and
  2302. ispowerof2(tordconstnode(right).value,i))) then
  2303. begin
  2304. if left.nodetype = ordconstn then
  2305. begin
  2306. tordconstnode(left).value := i;
  2307. result := cshlshrnode.create(shln,right,left);
  2308. end
  2309. else
  2310. begin
  2311. tordconstnode(right).value := i;
  2312. result := cshlshrnode.create(shln,left,right);
  2313. end;
  2314. left := nil;
  2315. right := nil;
  2316. exit;
  2317. end;
  2318. { 2 booleans ? }
  2319. if is_boolean(ld) and is_boolean(rd) then
  2320. begin
  2321. if (not(cs_full_boolean_eval in current_settings.localswitches) or
  2322. (nf_short_bool in flags)) and
  2323. (nodetype in [andn,orn]) then
  2324. expectloc:=LOC_JUMP
  2325. else
  2326. begin
  2327. if nodetype in [ltn,lten,gtn,gten,equaln,unequaln] then
  2328. expectloc:=LOC_FLAGS
  2329. else
  2330. expectloc:=LOC_REGISTER;
  2331. end;
  2332. end
  2333. else
  2334. { Both are chars? only convert to shortstrings for addn }
  2335. if is_char(ld) then
  2336. begin
  2337. if nodetype=addn then
  2338. internalerror(200103291);
  2339. expectloc:=LOC_FLAGS;
  2340. end
  2341. {$ifndef cpu64bitaddr}
  2342. { is there a 64 bit type ? }
  2343. else if (torddef(ld).ordtype in [s64bit,u64bit,scurrency]) then
  2344. begin
  2345. result := first_add64bitint;
  2346. if assigned(result) then
  2347. exit;
  2348. if nodetype in [addn,subn,muln,andn,orn,xorn] then
  2349. expectloc:=LOC_REGISTER
  2350. else
  2351. expectloc:=LOC_JUMP;
  2352. end
  2353. {$endif cpu64bitaddr}
  2354. { is there a cardinal? }
  2355. else if (torddef(ld).ordtype=u32bit) then
  2356. begin
  2357. if nodetype in [addn,subn,muln,andn,orn,xorn] then
  2358. expectloc:=LOC_REGISTER
  2359. else
  2360. expectloc:=LOC_FLAGS;
  2361. end
  2362. { generic s32bit conversion }
  2363. else
  2364. begin
  2365. if nodetype in [addn,subn,muln,andn,orn,xorn] then
  2366. expectloc:=LOC_REGISTER
  2367. else
  2368. expectloc:=LOC_FLAGS;
  2369. end;
  2370. end
  2371. { left side a setdef, must be before string processing,
  2372. else array constructor can be seen as array of char (PFV) }
  2373. else if (ld.typ=setdef) then
  2374. begin
  2375. { small sets are handled inline by the compiler.
  2376. small set doesn't have support for adding ranges }
  2377. if is_smallset(ld) and
  2378. not(
  2379. (right.nodetype=setelementn) and
  2380. assigned(tsetelementnode(right).right)
  2381. ) then
  2382. begin
  2383. if nodetype in [ltn,lten,gtn,gten,equaln,unequaln] then
  2384. expectloc:=LOC_FLAGS
  2385. else
  2386. expectloc:=LOC_REGISTER;
  2387. end
  2388. else
  2389. begin
  2390. result := first_addset;
  2391. if assigned(result) then
  2392. exit;
  2393. expectloc:=LOC_CREFERENCE;
  2394. end;
  2395. end
  2396. { compare pchar by addresses like BP/Delphi }
  2397. else if is_pchar(ld) then
  2398. begin
  2399. if nodetype in [addn,subn,muln,andn,orn,xorn] then
  2400. expectloc:=LOC_REGISTER
  2401. else
  2402. expectloc:=LOC_FLAGS;
  2403. end
  2404. { is one of the operands a string }
  2405. else if (ld.typ=stringdef) then
  2406. begin
  2407. if is_widestring(ld) then
  2408. begin
  2409. { this is only for add, the comparisaion is handled later }
  2410. expectloc:=LOC_REGISTER;
  2411. end
  2412. else if is_unicodestring(ld) then
  2413. begin
  2414. { this is only for add, the comparisaion is handled later }
  2415. expectloc:=LOC_REGISTER;
  2416. end
  2417. else if is_ansistring(ld) then
  2418. begin
  2419. { this is only for add, the comparisaion is handled later }
  2420. expectloc:=LOC_REGISTER;
  2421. end
  2422. else if is_longstring(ld) then
  2423. begin
  2424. { this is only for add, the comparisaion is handled later }
  2425. expectloc:=LOC_REFERENCE;
  2426. end
  2427. else
  2428. begin
  2429. {$ifdef addstringopt}
  2430. { can create a call which isn't handled by callparatemp }
  2431. if canbeaddsstringcharoptnode(self) then
  2432. begin
  2433. hp := genaddsstringcharoptnode(self);
  2434. pass_1 := hp;
  2435. exit;
  2436. end
  2437. else
  2438. {$endif addstringopt}
  2439. begin
  2440. { Fix right to be shortstring }
  2441. if is_char(right.resultdef) then
  2442. begin
  2443. inserttypeconv(right,cshortstringtype);
  2444. firstpass(right);
  2445. end;
  2446. end;
  2447. {$ifdef addstringopt}
  2448. { can create a call which isn't handled by callparatemp }
  2449. if canbeaddsstringcsstringoptnode(self) then
  2450. begin
  2451. hp := genaddsstringcsstringoptnode(self);
  2452. pass_1 := hp;
  2453. exit;
  2454. end;
  2455. {$endif addstringopt}
  2456. end;
  2457. { otherwise, let addstring convert everything }
  2458. result := first_addstring;
  2459. exit;
  2460. end
  2461. { is one a real float ? }
  2462. else if (rd.typ=floatdef) or (ld.typ=floatdef) then
  2463. begin
  2464. {$ifdef cpufpemu}
  2465. if (current_settings.fputype=fpu_soft) or (cs_fp_emulation in current_settings.moduleswitches) then
  2466. begin
  2467. result:=first_addfloat;
  2468. if assigned(result) then
  2469. exit;
  2470. end;
  2471. {$endif cpufpemu}
  2472. if nodetype in [addn,subn,muln,andn,orn,xorn] then
  2473. expectloc:=LOC_FPUREGISTER
  2474. else
  2475. expectloc:=LOC_FLAGS;
  2476. end
  2477. { pointer comperation and subtraction }
  2478. else if (ld.typ=pointerdef) then
  2479. begin
  2480. if nodetype in [addn,subn,muln,andn,orn,xorn] then
  2481. expectloc:=LOC_REGISTER
  2482. else
  2483. expectloc:=LOC_FLAGS;
  2484. end
  2485. else if is_class_or_interface(ld) then
  2486. begin
  2487. expectloc:=LOC_FLAGS;
  2488. end
  2489. else if (ld.typ=classrefdef) then
  2490. begin
  2491. expectloc:=LOC_FLAGS;
  2492. end
  2493. { support procvar=nil,procvar<>nil }
  2494. else if ((ld.typ=procvardef) and (rt=niln)) or
  2495. ((rd.typ=procvardef) and (lt=niln)) then
  2496. begin
  2497. expectloc:=LOC_FLAGS;
  2498. end
  2499. {$ifdef SUPPORT_MMX}
  2500. { mmx support, this must be before the zero based array
  2501. check }
  2502. else if (cs_mmx in current_settings.localswitches) and is_mmx_able_array(ld) and
  2503. is_mmx_able_array(rd) then
  2504. begin
  2505. expectloc:=LOC_MMXREGISTER;
  2506. end
  2507. {$endif SUPPORT_MMX}
  2508. else if (rd.typ=pointerdef) or (ld.typ=pointerdef) then
  2509. begin
  2510. expectloc:=LOC_REGISTER;
  2511. end
  2512. else if (rd.typ=procvardef) and
  2513. (ld.typ=procvardef) and
  2514. equal_defs(rd,ld) then
  2515. begin
  2516. expectloc:=LOC_FLAGS;
  2517. end
  2518. else if (ld.typ=enumdef) then
  2519. begin
  2520. expectloc:=LOC_FLAGS;
  2521. end
  2522. {$ifdef SUPPORT_MMX}
  2523. else if (cs_mmx in current_settings.localswitches) and
  2524. is_mmx_able_array(ld) and
  2525. is_mmx_able_array(rd) then
  2526. begin
  2527. expectloc:=LOC_MMXREGISTER;
  2528. end
  2529. {$endif SUPPORT_MMX}
  2530. { the general solution is to convert to 32 bit int }
  2531. else
  2532. begin
  2533. expectloc:=LOC_REGISTER;
  2534. end;
  2535. end;
  2536. {$ifdef state_tracking}
  2537. function Taddnode.track_state_pass(exec_known:boolean):boolean;
  2538. var factval:Tnode;
  2539. begin
  2540. track_state_pass:=false;
  2541. if left.track_state_pass(exec_known) then
  2542. begin
  2543. track_state_pass:=true;
  2544. left.resultdef:=nil;
  2545. do_typecheckpass(left);
  2546. end;
  2547. factval:=aktstate.find_fact(left);
  2548. if factval<>nil then
  2549. begin
  2550. track_state_pass:=true;
  2551. left.destroy;
  2552. left:=factval.getcopy;
  2553. end;
  2554. if right.track_state_pass(exec_known) then
  2555. begin
  2556. track_state_pass:=true;
  2557. right.resultdef:=nil;
  2558. do_typecheckpass(right);
  2559. end;
  2560. factval:=aktstate.find_fact(right);
  2561. if factval<>nil then
  2562. begin
  2563. track_state_pass:=true;
  2564. right.destroy;
  2565. right:=factval.getcopy;
  2566. end;
  2567. end;
  2568. {$endif}
  2569. begin
  2570. caddnode:=taddnode;
  2571. end.