nadd.pas 175 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725372637273728372937303731373237333734373537363737373837393740374137423743374437453746374737483749375037513752375337543755375637573758375937603761376237633764376537663767376837693770377137723773377437753776377737783779378037813782378337843785378637873788378937903791379237933794379537963797379837993800380138023803380438053806380738083809381038113812381338143815381638173818381938203821382238233824382538263827382838293830383138323833383438353836383738383839384038413842384338443845384638473848384938503851385238533854385538563857385838593860386138623863386438653866386738683869387038713872387338743875387638773878387938803881388238833884388538863887388838893890389138923893389438953896389738983899390039013902390339043905390639073908390939103911391239133914391539163917391839193920392139223923392439253926392739283929393039313932393339343935393639373938393939403941394239433944394539463947394839493950395139523953395439553956395739583959396039613962396339643965396639673968396939703971397239733974397539763977397839793980398139823983398439853986398739883989399039913992399339943995399639973998399940004001400240034004400540064007400840094010401140124013401440154016401740184019402040214022402340244025402640274028402940304031403240334034403540364037403840394040404140424043404440454046404740484049405040514052405340544055405640574058405940604061406240634064406540664067406840694070407140724073407440754076407740784079408040814082408340844085408640874088408940904091409240934094409540964097409840994100410141024103410441054106410741084109411041114112411341144115411641174118411941204121412241234124412541264127412841294130413141324133413441354136413741384139414041414142414341444145414641474148414941504151415241534154415541564157415841594160416141624163416441654166416741684169417041714172417341744175417641774178417941804181418241834184418541864187418841894190419141924193419441954196419741984199420042014202420342044205420642074208420942104211421242134214421542164217421842194220422142224223422442254226422742284229423042314232423342344235423642374238423942404241424242434244424542464247424842494250425142524253425442554256425742584259426042614262426342644265426642674268426942704271427242734274427542764277427842794280428142824283428442854286428742884289429042914292
  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. {$modeswitch nestedprocvars}
  20. { define addstringopt}
  21. interface
  22. uses
  23. node,symtype;
  24. type
  25. taddnode = class(tbinopnode)
  26. private
  27. resultrealdefderef: tderef;
  28. function pass_typecheck_internal:tnode;
  29. public
  30. resultrealdef : tdef;
  31. constructor create(tt : tnodetype;l,r : tnode);override;
  32. constructor create_internal(tt:tnodetype;l,r:tnode);
  33. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  34. procedure ppuwrite(ppufile:tcompilerppufile);override;
  35. procedure buildderefimpl;override;
  36. procedure derefimpl;override;
  37. function pass_1 : tnode;override;
  38. function pass_typecheck:tnode;override;
  39. function simplify(forinline: boolean) : tnode;override;
  40. function dogetcopy : tnode;override;
  41. function docompare(p: tnode): boolean; override;
  42. {$ifdef state_tracking}
  43. function track_state_pass(exec_known:boolean):boolean;override;
  44. {$endif}
  45. protected
  46. { override the following if you want to implement }
  47. { parts explicitely in the code generator (JM) }
  48. function first_addstring: tnode; virtual;
  49. function first_addset: tnode; virtual;
  50. function first_adddynarray : tnode; virtual;
  51. { only implements "muln" nodes, the rest always has to be done in }
  52. { the code generator for performance reasons (JM) }
  53. function first_add64bitint: tnode; virtual;
  54. function first_addpointer: tnode; virtual;
  55. function first_cmppointer: tnode; virtual;
  56. { override and return false if you can handle 32x32->64 }
  57. { bit multiplies directly in your code generator. If }
  58. { this function is overridden to return false, you can }
  59. { get multiplies with left/right both s32bit or u32bit, }
  60. { and resultdef of the muln s64bit or u64bit }
  61. function use_generic_mul32to64: boolean; virtual;
  62. { override and return false if code generator can handle }
  63. { full 64 bit multiplies. }
  64. function use_generic_mul64bit: boolean; virtual;
  65. {$ifdef cpuneedsmulhelper}
  66. { override to customize to decide if the code generator }
  67. { can handle a given multiply node directly, or it needs helpers }
  68. function use_mul_helper: boolean; virtual;
  69. {$endif cpuneedsmulhelper}
  70. { shall be overriden if the target cpu supports
  71. an fma instruction
  72. }
  73. function use_fma : boolean; virtual;
  74. { This routine calls internal runtime library helpers
  75. for all floating point arithmetic in the case
  76. where the emulation switches is on. Otherwise
  77. returns nil, and everything must be done in
  78. the code generation phase.
  79. }
  80. function first_addfloat : tnode; virtual;
  81. {
  82. generates softfloat code for the node
  83. }
  84. function first_addfloat_soft: tnode; virtual;
  85. private
  86. { checks whether a muln can be calculated as a 32bit }
  87. { * 32bit -> 64 bit }
  88. function try_make_mul32to64: boolean;
  89. { Match against the ranges, i.e.:
  90. var a:1..10;
  91. begin
  92. if a>0 then
  93. ...
  94. always evaluates to true. (DM)
  95. }
  96. function cmp_of_disjunct_ranges(var res : boolean) : boolean;
  97. { tries to replace the current node by a fma node }
  98. function try_fma(ld,rd : tdef) : tnode;
  99. end;
  100. taddnodeclass = class of taddnode;
  101. var
  102. { caddnode is used to create nodes of the add type }
  103. { the virtual constructor allows to assign }
  104. { another class type to caddnode => processor }
  105. { specific node types can be created }
  106. caddnode : taddnodeclass = taddnode;
  107. implementation
  108. uses
  109. {$IFNDEF USE_FAKE_SYSUTILS}
  110. sysutils,
  111. {$ELSE}
  112. fksysutl,
  113. {$ENDIF}
  114. globtype,systems,constexp,compinnr,
  115. cutils,verbose,globals,widestr,
  116. tokens,
  117. symconst,symdef,symsym,symcpu,symtable,defutil,defcmp,
  118. cgbase,
  119. htypechk,pass_1,
  120. nld,nbas,nmat,ncnv,ncon,nset,nopt,ncal,ninl,nmem,nutils,
  121. {$ifdef state_tracking}
  122. nstate,
  123. {$endif}
  124. cpuinfo;
  125. {*****************************************************************************
  126. TADDNODE
  127. *****************************************************************************}
  128. {$maxfpuregisters 0}
  129. function getbestreal(t1,t2 : tdef) : tdef;
  130. const
  131. floatweight : array[tfloattype] of byte =
  132. (2,3,4,5,0,1,6);
  133. begin
  134. if t1.typ=floatdef then
  135. begin
  136. result:=t1;
  137. if t2.typ=floatdef then
  138. begin
  139. { when a comp or currency is used, use always the
  140. best float type to calculate the result }
  141. if (tfloatdef(t1).floattype in [s64comp,s64currency]) or
  142. (tfloatdef(t2).floattype in [s64comp,s64currency]) or
  143. (cs_excessprecision in current_settings.localswitches) then
  144. result:=pbestrealtype^
  145. else
  146. if floatweight[tfloatdef(t2).floattype]>floatweight[tfloatdef(t1).floattype] then
  147. result:=t2;
  148. end;
  149. end
  150. else if t2.typ=floatdef then
  151. result:=t2
  152. else internalerror(200508061);
  153. end;
  154. constructor taddnode.create(tt : tnodetype;l,r : tnode);
  155. begin
  156. inherited create(tt,l,r);
  157. end;
  158. constructor taddnode.create_internal(tt:tnodetype;l,r:tnode);
  159. begin
  160. create(tt,l,r);
  161. include(flags,nf_internal);
  162. end;
  163. constructor taddnode.ppuload(t: tnodetype; ppufile: tcompilerppufile);
  164. begin
  165. inherited ppuload(t, ppufile);
  166. ppufile.getderef(resultrealdefderef);
  167. end;
  168. procedure taddnode.ppuwrite(ppufile: tcompilerppufile);
  169. begin
  170. inherited ppuwrite(ppufile);
  171. ppufile.putderef(resultrealdefderef);
  172. end;
  173. procedure taddnode.buildderefimpl;
  174. begin
  175. inherited buildderefimpl;
  176. resultrealdefderef.build(resultrealdef);
  177. end;
  178. procedure taddnode.derefimpl;
  179. begin
  180. inherited derefimpl;
  181. resultrealdef:=tdef(resultrealdefderef.resolve);
  182. end;
  183. function taddnode.cmp_of_disjunct_ranges(var res : boolean) : boolean;
  184. var
  185. hp : tnode;
  186. realdef : tdef;
  187. v : tconstexprint;
  188. begin
  189. result:=false;
  190. { check for comparision with known result because the ranges of the operands don't overlap }
  191. if (is_constintnode(right) and (left.resultdef.typ=orddef) and
  192. { don't ignore type checks }
  193. is_subequal(right.resultdef,left.resultdef)) or
  194. (is_constintnode(left) and (right.resultdef.typ=orddef) and
  195. { don't ignore type checks }
  196. is_subequal(left.resultdef,right.resultdef)) then
  197. begin
  198. if is_constintnode(right) then
  199. begin
  200. hp:=left;
  201. v:=Tordconstnode(right).value;
  202. end
  203. else
  204. begin
  205. hp:=right;
  206. v:=Tordconstnode(left).value;
  207. end;
  208. realdef:=hp.resultdef;
  209. { stop with finding the real def when we either encounter
  210. a) an explicit type conversion (then the value has to be
  211. re-interpreted)
  212. b) an "absolute" type conversion (also requires
  213. re-interpretation)
  214. }
  215. while (hp.nodetype=typeconvn) and
  216. ([nf_internal,nf_explicit,nf_absolute] * hp.flags = []) do
  217. begin
  218. hp:=ttypeconvnode(hp).left;
  219. realdef:=hp.resultdef;
  220. end;
  221. if is_constintnode(left) then
  222. with torddef(realdef) do
  223. case nodetype of
  224. ltn:
  225. if v<low then
  226. begin
  227. result:=true;
  228. res:=true;
  229. end
  230. else if v>=high then
  231. begin
  232. result:=true;
  233. res:=false;
  234. end;
  235. lten:
  236. if v<=low then
  237. begin
  238. result:=true;
  239. res:=true;
  240. end
  241. else if v>high then
  242. begin
  243. result:=true;
  244. res:=false;
  245. end;
  246. gtn:
  247. if v<=low then
  248. begin
  249. result:=true;
  250. res:=false;
  251. end
  252. else if v>high then
  253. begin
  254. result:=true;
  255. res:=true;
  256. end;
  257. gten :
  258. if v<low then
  259. begin
  260. result:=true;
  261. res:=false;
  262. end
  263. else if v>=high then
  264. begin
  265. result:=true;
  266. res:=true;
  267. end;
  268. equaln:
  269. if (v<low) or (v>high) then
  270. begin
  271. result:=true;
  272. res:=false;
  273. end;
  274. unequaln:
  275. if (v<low) or (v>high) then
  276. begin
  277. result:=true;
  278. res:=true;
  279. end;
  280. else
  281. ;
  282. end
  283. else
  284. with torddef(realdef) do
  285. case nodetype of
  286. ltn:
  287. if high<v then
  288. begin
  289. result:=true;
  290. res:=true;
  291. end
  292. else if low>=v then
  293. begin
  294. result:=true;
  295. res:=false;
  296. end;
  297. lten:
  298. if high<=v then
  299. begin
  300. result:=true;
  301. res:=true;
  302. end
  303. else if low>v then
  304. begin
  305. result:=true;
  306. res:=false;
  307. end;
  308. gtn:
  309. if high<=v then
  310. begin
  311. result:=true;
  312. res:=false;
  313. end
  314. else if low>v then
  315. begin
  316. result:=true;
  317. res:=true;
  318. end;
  319. gten:
  320. if high<v then
  321. begin
  322. result:=true;
  323. res:=false;
  324. end
  325. else if low>=v then
  326. begin
  327. result:=true;
  328. res:=true;
  329. end;
  330. equaln:
  331. if (v<low) or (v>high) then
  332. begin
  333. result:=true;
  334. res:=false;
  335. end;
  336. unequaln:
  337. if (v<low) or (v>high) then
  338. begin
  339. result:=true;
  340. res:=true;
  341. end;
  342. else
  343. ;
  344. end;
  345. end;
  346. end;
  347. function taddnode.simplify(forinline : boolean) : tnode;
  348. function is_range_test(nodel, noder: taddnode; out value: tnode; var cl,cr: Tconstexprint): boolean;
  349. const
  350. is_upper_test: array[ltn..gten] of boolean = (true,true,false,false);
  351. inclusive_adjust: array[boolean,ltn..gten] of integer = ((-1,0,1,0),
  352. (1,0,-1,0));
  353. var
  354. swapl, swapr: Boolean;
  355. valuer: tnode;
  356. t: Tconstexprint;
  357. begin
  358. result:=false;
  359. swapl:=false;
  360. swapr:=false;
  361. if nodel.left.nodetype=ordconstn then
  362. begin
  363. swapl:=true;
  364. cl:=tordconstnode(nodel.left).value;
  365. value:=nodel.right;
  366. end
  367. else if nodel.right.nodetype=ordconstn then
  368. begin
  369. cl:=tordconstnode(nodel.right).value;
  370. value:=nodel.left;
  371. end
  372. else
  373. exit;
  374. if noder.left.nodetype=ordconstn then
  375. begin
  376. swapl:=true;
  377. cr:=tordconstnode(noder.left).value;
  378. valuer:=noder.right;
  379. end
  380. else if noder.right.nodetype=ordconstn then
  381. begin
  382. cr:=tordconstnode(noder.right).value;
  383. valuer:=noder.left;
  384. end
  385. else
  386. exit;
  387. if not value.isequal(valuer) then
  388. exit;
  389. { this could be simplified too, but probably never happens }
  390. if (is_upper_test[nodel.nodetype] xor swapl)=(is_upper_test[noder.nodetype] xor swapr) then
  391. exit;
  392. cl:=cl+inclusive_adjust[swapl,nodel.nodetype];
  393. cr:=cr+inclusive_adjust[swapr,noder.nodetype];
  394. if is_upper_test[nodel.nodetype] xor swapl then
  395. begin
  396. t:=cl;
  397. cl:=cr;
  398. cr:=t;
  399. end;
  400. if cl>cr then
  401. exit;
  402. result:=true;
  403. end;
  404. function IsLengthZero(n1,n2 : tnode) : Boolean;
  405. begin
  406. result:=is_inlinefunction(n1,in_length_x) and is_constintvalue(n2,0) and not(is_shortstring(tinlinenode(n1).left.resultdef));
  407. end;
  408. function TransformLengthZero(n1,n2 : tnode) : tnode;
  409. var
  410. len : Tconstexprint;
  411. begin
  412. if is_dynamic_array(tinlinenode(n1).left.resultdef) then
  413. len:=-1
  414. else
  415. len:=0;
  416. result:=caddnode.create_internal(orn,
  417. caddnode.create_internal(equaln,ctypeconvnode.create_internal(tinlinenode(n1).left.getcopy,voidpointertype),
  418. cpointerconstnode.create(0,voidpointertype)),
  419. caddnode.create_internal(equaln,
  420. ctypeconvnode.create_internal(
  421. cderefnode.create(
  422. caddnode.create_internal(subn,ctypeconvnode.create_internal(tinlinenode(n1).left.getcopy,voidpointertype),
  423. cordconstnode.create(sizesinttype.size,sizesinttype,false))
  424. ),sizesinttype
  425. ),
  426. cordconstnode.create(len,sizesinttype,false))
  427. );
  428. end;
  429. function GetCopyAndTypeCheck: tnode;
  430. begin
  431. result:=getcopy;
  432. result.resultdef:=nil;
  433. result:=ctypeconvnode.create_internal(result,resultdef);
  434. do_typecheckpass(result);
  435. end;
  436. var
  437. t , vl, hp: tnode;
  438. lt,rt : tnodetype;
  439. hdef,
  440. rd,ld : tdef;
  441. rv,lv,v : tconstexprint;
  442. rvd,lvd : bestreal;
  443. ws1,ws2 : pcompilerwidestring;
  444. concatstrings : boolean;
  445. c1,c2 : array[0..1] of char;
  446. s1,s2 : pchar;
  447. l1,l2 : longint;
  448. resultset : Tconstset;
  449. res,
  450. b : boolean;
  451. cr, cl : Tconstexprint;
  452. begin
  453. result:=nil;
  454. l1:=0;
  455. l2:=0;
  456. s1:=nil;
  457. s2:=nil;
  458. { load easier access variables }
  459. rd:=right.resultdef;
  460. ld:=left.resultdef;
  461. rt:=right.nodetype;
  462. lt:=left.nodetype;
  463. if (nodetype = slashn) and
  464. (((rt = ordconstn) and
  465. (tordconstnode(right).value = 0)) or
  466. ((rt = realconstn) and
  467. (trealconstnode(right).value_real = 0.0))) then
  468. begin
  469. if floating_point_range_check_error then
  470. begin
  471. result:=crealconstnode.create(1,pbestrealtype^);
  472. Message(parser_e_division_by_zero);
  473. exit;
  474. end;
  475. end;
  476. { both are int constants }
  477. if (
  478. is_constintnode(left) and
  479. is_constintnode(right)
  480. ) or
  481. (
  482. is_constboolnode(left) and
  483. is_constboolnode(right) and
  484. (nodetype in [slashn,ltn,lten,gtn,gten,equaln,unequaln,andn,xorn,orn])
  485. ) or
  486. (
  487. is_constenumnode(left) and
  488. is_constenumnode(right) and
  489. (allowenumop(nodetype) or (nf_internal in flags))
  490. ) or
  491. (
  492. (lt = pointerconstn) and
  493. is_constintnode(right) and
  494. (nodetype in [addn,subn])
  495. ) or
  496. (
  497. (rt = pointerconstn) and
  498. is_constintnode(left) and
  499. (nodetype=addn)
  500. ) or
  501. (
  502. (lt in [pointerconstn,niln]) and
  503. (rt in [pointerconstn,niln]) and
  504. (nodetype in [ltn,lten,gtn,gten,equaln,unequaln,subn])
  505. ) or
  506. (
  507. (lt = ordconstn) and (ld.typ = orddef) and is_currency(ld) and
  508. (rt = ordconstn) and (rd.typ = orddef) and is_currency(rd)
  509. ) then
  510. begin
  511. t:=nil;
  512. { load values }
  513. case lt of
  514. ordconstn:
  515. lv:=tordconstnode(left).value;
  516. pointerconstn:
  517. lv:=tpointerconstnode(left).value;
  518. niln:
  519. lv:=0;
  520. else
  521. internalerror(2002080202);
  522. end;
  523. case rt of
  524. ordconstn:
  525. rv:=tordconstnode(right).value;
  526. pointerconstn:
  527. rv:=tpointerconstnode(right).value;
  528. niln:
  529. rv:=0;
  530. else
  531. internalerror(2002080203);
  532. end;
  533. { type checking already took care of multiplying }
  534. { integer constants with pointeddef.size if necessary }
  535. case nodetype of
  536. addn :
  537. begin
  538. v:=lv+rv;
  539. if v.overflow then
  540. begin
  541. Message(parser_e_arithmetic_operation_overflow);
  542. { Recover }
  543. t:=genintconstnode(0)
  544. end
  545. else if (lt=pointerconstn) or (rt=pointerconstn) then
  546. t := cpointerconstnode.create(qword(v),resultdef)
  547. else
  548. if is_integer(ld) then
  549. t := create_simplified_ord_const(v,resultdef,forinline,cs_check_overflow in localswitches)
  550. else
  551. t := cordconstnode.create(v,resultdef,(ld.typ<>enumdef));
  552. end;
  553. subn :
  554. begin
  555. v:=lv-rv;
  556. if v.overflow then
  557. begin
  558. Message(parser_e_arithmetic_operation_overflow);
  559. { Recover }
  560. t:=genintconstnode(0)
  561. end
  562. else if (lt=pointerconstn) then
  563. { pointer-pointer results in an integer }
  564. if (rt=pointerconstn) then
  565. begin
  566. if not(nf_has_pointerdiv in flags) then
  567. internalerror(2008030101);
  568. t := cpointerconstnode.create(qword(v),resultdef)
  569. end
  570. else
  571. t := cpointerconstnode.create(qword(v),resultdef)
  572. else
  573. if is_integer(ld) then
  574. t := create_simplified_ord_const(v,resultdef,forinline,cs_check_overflow in localswitches)
  575. else
  576. t:=cordconstnode.create(v,resultdef,(ld.typ<>enumdef));
  577. end;
  578. muln :
  579. begin
  580. v:=lv*rv;
  581. if v.overflow then
  582. begin
  583. message(parser_e_arithmetic_operation_overflow);
  584. { Recover }
  585. t:=genintconstnode(0)
  586. end
  587. else
  588. t := create_simplified_ord_const(v,resultdef,forinline,cs_check_overflow in localswitches)
  589. end;
  590. xorn :
  591. if is_integer(ld) then
  592. t := create_simplified_ord_const(lv xor rv,resultdef,forinline,false)
  593. else
  594. t:=cordconstnode.create(lv xor rv,resultdef,true);
  595. orn :
  596. if is_integer(ld) then
  597. t:=create_simplified_ord_const(lv or rv,resultdef,forinline,false)
  598. else
  599. t:=cordconstnode.create(lv or rv,resultdef,true);
  600. andn :
  601. if is_integer(ld) then
  602. t:=create_simplified_ord_const(lv and rv,resultdef,forinline,false)
  603. else
  604. t:=cordconstnode.create(lv and rv,resultdef,true);
  605. ltn :
  606. t:=cordconstnode.create(ord(lv<rv),pasbool1type,true);
  607. lten :
  608. t:=cordconstnode.create(ord(lv<=rv),pasbool1type,true);
  609. gtn :
  610. t:=cordconstnode.create(ord(lv>rv),pasbool1type,true);
  611. gten :
  612. t:=cordconstnode.create(ord(lv>=rv),pasbool1type,true);
  613. equaln :
  614. t:=cordconstnode.create(ord(lv=rv),pasbool1type,true);
  615. unequaln :
  616. t:=cordconstnode.create(ord(lv<>rv),pasbool1type,true);
  617. slashn :
  618. begin
  619. { int/int becomes a real }
  620. rvd:=rv;
  621. lvd:=lv;
  622. t:=crealconstnode.create(lvd/rvd,resultrealdef);
  623. end;
  624. else
  625. internalerror(2008022101);
  626. end;
  627. if not forinline then
  628. include(t.flags,nf_internal);
  629. result:=t;
  630. exit;
  631. end
  632. else if cmp_of_disjunct_ranges(res) then
  633. begin
  634. if res then
  635. t:=Cordconstnode.create(1,pasbool1type,true)
  636. else
  637. t:=Cordconstnode.create(0,pasbool1type,true);
  638. { don't do this optimization, if the variable expression might
  639. have a side effect }
  640. if (is_constintnode(left) and might_have_sideeffects(right)) or
  641. (is_constintnode(right) and might_have_sideeffects(left)) then
  642. t.free
  643. else
  644. result:=t;
  645. exit;
  646. end;
  647. { Add,Sub,Mul,Or,Xor,Andn with constant 0, 1 or -1? }
  648. if is_constintnode(right) and (is_integer(left.resultdef) or is_pointer(left.resultdef)) then
  649. begin
  650. if tordconstnode(right).value = 0 then
  651. begin
  652. case nodetype of
  653. addn,subn,orn,xorn:
  654. result := left.getcopy;
  655. andn,muln:
  656. begin
  657. if (cs_opt_level4 in current_settings.optimizerswitches) or
  658. not might_have_sideeffects(left) then
  659. result:=cordconstnode.create(0,resultdef,true);
  660. end
  661. else
  662. ;
  663. end;
  664. end
  665. else if tordconstnode(right).value = 1 then
  666. begin
  667. case nodetype of
  668. muln:
  669. result := left.getcopy;
  670. else
  671. ;
  672. end;
  673. end
  674. else if tordconstnode(right).value = -1 then
  675. begin
  676. case nodetype of
  677. muln:
  678. result := cunaryminusnode.create(left.getcopy);
  679. else
  680. ;
  681. end;
  682. end
  683. { try to fold
  684. op op
  685. / \ / \
  686. op const1 or op const1
  687. / \ / \
  688. const2 val val const2
  689. }
  690. else if (left.nodetype=nodetype) and
  691. { there might be a mul operation e.g. longint*longint => int64 in this case
  692. we cannot do this optimziation, see e.g. tests/webtbs/tw36587.pp on arm }
  693. (compare_defs(resultdef,left.resultdef,nothingn)=te_exact) then
  694. begin
  695. if is_constintnode(taddnode(left).left) then
  696. begin
  697. case left.nodetype of
  698. xorn,
  699. addn,
  700. andn,
  701. orn,
  702. muln:
  703. begin
  704. hp:=right;
  705. right:=taddnode(left).right;
  706. taddnode(left).right:=hp;
  707. if resultdef.typ<>pointerdef then
  708. begin
  709. { ensure that the constant is not expanded to a larger type due to overflow,
  710. but this is only useful if no pointer operation is done }
  711. left:=ctypeconvnode.create_internal(left,resultdef);
  712. do_typecheckpass(left);
  713. end;
  714. result:=GetCopyAndTypeCheck;
  715. end;
  716. else
  717. ;
  718. end;
  719. end
  720. else if is_constintnode(taddnode(left).right) then
  721. begin
  722. case left.nodetype of
  723. xorn,
  724. addn,
  725. andn,
  726. orn,
  727. muln:
  728. begin
  729. { keep the order of val+const else pointer operations might cause an error }
  730. hp:=taddnode(left).left;
  731. taddnode(left).left:=right;
  732. left:=left.simplify(forinline);
  733. if resultdef.typ<>pointerdef then
  734. begin
  735. { ensure that the constant is not expanded to a larger type due to overflow,
  736. but this is only useful if no pointer operation is done }
  737. left:=ctypeconvnode.create_internal(left,resultdef);
  738. do_typecheckpass(left);
  739. end;
  740. right:=left;
  741. left:=hp;
  742. result:=GetCopyAndTypeCheck;
  743. end;
  744. else
  745. ;
  746. end;
  747. end
  748. end;
  749. if assigned(result) then
  750. exit;
  751. end;
  752. if is_constintnode(left) and (is_integer(right.resultdef) or is_pointer(right.resultdef)) then
  753. begin
  754. if tordconstnode(left).value = 0 then
  755. begin
  756. case nodetype of
  757. addn,orn,xorn:
  758. result := right.getcopy;
  759. subn:
  760. result := cunaryminusnode.create(right.getcopy);
  761. andn,muln:
  762. begin
  763. if (cs_opt_level4 in current_settings.optimizerswitches) or
  764. not might_have_sideeffects(right) then
  765. result:=cordconstnode.create(0,resultdef,true);
  766. end;
  767. else
  768. ;
  769. end;
  770. end
  771. else if tordconstnode(left).value = 1 then
  772. begin
  773. case nodetype of
  774. muln:
  775. result := right.getcopy;
  776. else
  777. ;
  778. end;
  779. end
  780. else if tordconstnode(left).value = -1 then
  781. begin
  782. case nodetype of
  783. muln:
  784. result := cunaryminusnode.create(right.getcopy);
  785. else
  786. ;
  787. end;
  788. end
  789. { try to fold
  790. op
  791. / \
  792. const1 op
  793. / \
  794. const2 val
  795. }
  796. else if (right.nodetype=nodetype) and
  797. { there might be a mul operation e.g. longint*longint => int64 in this case
  798. we cannot do this optimziation, see e.g. tests/webtbs/tw36587.pp on arm }
  799. (compare_defs(resultdef,right.resultdef,nothingn)=te_exact) then
  800. begin
  801. if is_constintnode(taddnode(right).left) then
  802. begin
  803. case right.nodetype of
  804. xorn,
  805. addn,
  806. andn,
  807. orn,
  808. muln:
  809. begin
  810. hp:=left;
  811. left:=taddnode(right).right;
  812. taddnode(right).right:=hp;
  813. right:=right.simplify(false);
  814. result:=GetCopyAndTypeCheck;
  815. end;
  816. else
  817. ;
  818. end;
  819. end
  820. else if is_constintnode(taddnode(right).right) then
  821. begin
  822. case right.nodetype of
  823. xorn,
  824. addn,
  825. andn,
  826. orn,
  827. muln:
  828. begin
  829. hp:=left;
  830. left:=taddnode(right).left;
  831. taddnode(right).left:=hp;
  832. right:=right.simplify(false);
  833. result:=GetCopyAndTypeCheck;
  834. end;
  835. else
  836. ;
  837. end;
  838. end
  839. end;
  840. if assigned(result) then
  841. exit;
  842. end;
  843. { both real constants ? }
  844. if (lt=realconstn) and (rt=realconstn) then
  845. begin
  846. lvd:=trealconstnode(left).value_real;
  847. rvd:=trealconstnode(right).value_real;
  848. case nodetype of
  849. addn :
  850. t:=crealconstnode.create(lvd+rvd,resultrealdef);
  851. subn :
  852. t:=crealconstnode.create(lvd-rvd,resultrealdef);
  853. muln :
  854. t:=crealconstnode.create(lvd*rvd,resultrealdef);
  855. starstarn:
  856. begin
  857. if lvd<0 then
  858. begin
  859. Message(parser_e_invalid_float_operation);
  860. t:=crealconstnode.create(0,resultrealdef);
  861. end
  862. else if lvd=0 then
  863. t:=crealconstnode.create(1.0,resultrealdef)
  864. else
  865. t:=crealconstnode.create(exp(ln(lvd)*rvd),resultrealdef);
  866. end;
  867. slashn :
  868. t:=crealconstnode.create(lvd/rvd,resultrealdef);
  869. ltn :
  870. t:=cordconstnode.create(ord(lvd<rvd),pasbool1type,true);
  871. lten :
  872. t:=cordconstnode.create(ord(lvd<=rvd),pasbool1type,true);
  873. gtn :
  874. t:=cordconstnode.create(ord(lvd>rvd),pasbool1type,true);
  875. gten :
  876. t:=cordconstnode.create(ord(lvd>=rvd),pasbool1type,true);
  877. equaln :
  878. t:=cordconstnode.create(ord(lvd=rvd),pasbool1type,true);
  879. unequaln :
  880. t:=cordconstnode.create(ord(lvd<>rvd),pasbool1type,true);
  881. else
  882. internalerror(2008022102);
  883. end;
  884. result:=t;
  885. if nf_is_currency in flags then
  886. include(result.flags,nf_is_currency);
  887. exit;
  888. end;
  889. {$if (FPC_FULLVERSION>20700) and not defined(FPC_SOFT_FPUX80)}
  890. { bestrealrec is 2.7.1+ only }
  891. { replace .../const by a multiplication, but only if fastmath is enabled or
  892. the division is done by a power of 2, do not mess with special floating point values like Inf etc.
  893. do this after constant folding to avoid unnecessary precision loss if
  894. an slash expresion would be first converted into a multiplication and later
  895. folded }
  896. if (nodetype=slashn) and
  897. { do not mess with currency and comp types }
  898. (not(is_currency(right.resultdef)) and
  899. not((right.resultdef.typ=floatdef) and
  900. (tfloatdef(right.resultdef).floattype=s64comp)
  901. )
  902. ) and
  903. (((cs_opt_fastmath in current_settings.optimizerswitches) and (rt=ordconstn)) or
  904. ((cs_opt_fastmath in current_settings.optimizerswitches) and (rt=realconstn) and
  905. (bestrealrec(trealconstnode(right).value_real).SpecialType in [fsPositive,fsNegative])
  906. ) or
  907. ((rt=realconstn) and
  908. (bestrealrec(trealconstnode(right).value_real).SpecialType in [fsPositive,fsNegative]) and
  909. { mantissa returns the mantissa/fraction without the hidden 1, so power of two means only the hidden
  910. bit is set => mantissa must be 0 }
  911. (bestrealrec(trealconstnode(right).value_real).Mantissa=0)
  912. )
  913. ) then
  914. case rt of
  915. ordconstn:
  916. begin
  917. { the normal code handles div/0 }
  918. if (tordconstnode(right).value<>0) then
  919. begin
  920. nodetype:=muln;
  921. t:=crealconstnode.create(1/tordconstnode(right).value,resultdef);
  922. right.free;
  923. right:=t;
  924. exit;
  925. end;
  926. end;
  927. realconstn:
  928. begin
  929. nodetype:=muln;
  930. trealconstnode(right).value_real:=1.0/trealconstnode(right).value_real;
  931. exit;
  932. end;
  933. else
  934. ;
  935. end;
  936. {$endif FPC_FULLVERSION>20700}
  937. { first, we handle widestrings, so we can check later for }
  938. { stringconstn only }
  939. { widechars are converted above to widestrings too }
  940. { this isn't ver y efficient, but I don't think }
  941. { that it does matter that much (FK) }
  942. if (lt=stringconstn) and (rt=stringconstn) and
  943. (tstringconstnode(left).cst_type in [cst_widestring,cst_unicodestring]) and
  944. (tstringconstnode(right).cst_type in [cst_widestring,cst_unicodestring]) then
  945. begin
  946. initwidestring(ws1);
  947. initwidestring(ws2);
  948. copywidestring(pcompilerwidestring(tstringconstnode(left).value_str),ws1);
  949. copywidestring(pcompilerwidestring(tstringconstnode(right).value_str),ws2);
  950. case nodetype of
  951. addn :
  952. begin
  953. concatwidestrings(ws1,ws2);
  954. t:=cstringconstnode.createunistr(ws1);
  955. end;
  956. ltn :
  957. t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<0),pasbool1type,true);
  958. lten :
  959. t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<=0),pasbool1type,true);
  960. gtn :
  961. t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)>0),pasbool1type,true);
  962. gten :
  963. t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)>=0),pasbool1type,true);
  964. equaln :
  965. t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)=0),pasbool1type,true);
  966. unequaln :
  967. t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<>0),pasbool1type,true);
  968. else
  969. internalerror(2008022103);
  970. end;
  971. donewidestring(ws1);
  972. donewidestring(ws2);
  973. result:=t;
  974. exit;
  975. end;
  976. { concating strings ? }
  977. concatstrings:=false;
  978. if (lt=ordconstn) and (rt=ordconstn) and
  979. is_char(ld) and is_char(rd) then
  980. begin
  981. c1[0]:=char(int64(tordconstnode(left).value));
  982. c1[1]:=#0;
  983. l1:=1;
  984. c2[0]:=char(int64(tordconstnode(right).value));
  985. c2[1]:=#0;
  986. l2:=1;
  987. s1:=@c1[0];
  988. s2:=@c2[0];
  989. concatstrings:=true;
  990. end
  991. else if (lt=stringconstn) and (rt=ordconstn) and is_char(rd) then
  992. begin
  993. s1:=tstringconstnode(left).value_str;
  994. l1:=tstringconstnode(left).len;
  995. c2[0]:=char(int64(tordconstnode(right).value));
  996. c2[1]:=#0;
  997. s2:=@c2[0];
  998. l2:=1;
  999. concatstrings:=true;
  1000. end
  1001. else if (lt=ordconstn) and (rt=stringconstn) and is_char(ld) then
  1002. begin
  1003. c1[0]:=char(int64(tordconstnode(left).value));
  1004. c1[1]:=#0;
  1005. l1:=1;
  1006. s1:=@c1[0];
  1007. s2:=tstringconstnode(right).value_str;
  1008. l2:=tstringconstnode(right).len;
  1009. concatstrings:=true;
  1010. end
  1011. else if (lt=stringconstn) and (rt=stringconstn) then
  1012. begin
  1013. s1:=tstringconstnode(left).value_str;
  1014. l1:=tstringconstnode(left).len;
  1015. s2:=tstringconstnode(right).value_str;
  1016. l2:=tstringconstnode(right).len;
  1017. concatstrings:=true;
  1018. end;
  1019. if concatstrings then
  1020. begin
  1021. case nodetype of
  1022. addn :
  1023. begin
  1024. t:=cstringconstnode.createpchar(concatansistrings(s1,s2,l1,l2),l1+l2,nil);
  1025. typecheckpass(t);
  1026. if not is_ansistring(resultdef) or
  1027. (tstringdef(resultdef).encoding<>globals.CP_NONE) then
  1028. tstringconstnode(t).changestringtype(resultdef)
  1029. else
  1030. tstringconstnode(t).changestringtype(getansistringdef)
  1031. end;
  1032. ltn :
  1033. t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<0),pasbool1type,true);
  1034. lten :
  1035. t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<=0),pasbool1type,true);
  1036. gtn :
  1037. t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)>0),pasbool1type,true);
  1038. gten :
  1039. t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)>=0),pasbool1type,true);
  1040. equaln :
  1041. t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)=0),pasbool1type,true);
  1042. unequaln :
  1043. t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<>0),pasbool1type,true);
  1044. else
  1045. internalerror(2008022104);
  1046. end;
  1047. result:=t;
  1048. exit;
  1049. end;
  1050. { set constant evaluation }
  1051. if (right.nodetype=setconstn) and
  1052. not assigned(tsetconstnode(right).left) and
  1053. (left.nodetype=setconstn) and
  1054. not assigned(tsetconstnode(left).left) then
  1055. begin
  1056. case nodetype of
  1057. addn :
  1058. begin
  1059. resultset:=tsetconstnode(right).value_set^ + tsetconstnode(left).value_set^;
  1060. t:=csetconstnode.create(@resultset,resultdef);
  1061. end;
  1062. muln :
  1063. begin
  1064. resultset:=tsetconstnode(right).value_set^ * tsetconstnode(left).value_set^;
  1065. t:=csetconstnode.create(@resultset,resultdef);
  1066. end;
  1067. subn :
  1068. begin
  1069. resultset:=tsetconstnode(left).value_set^ - tsetconstnode(right).value_set^;
  1070. t:=csetconstnode.create(@resultset,resultdef);
  1071. end;
  1072. symdifn :
  1073. begin
  1074. resultset:=tsetconstnode(right).value_set^ >< tsetconstnode(left).value_set^;
  1075. t:=csetconstnode.create(@resultset,resultdef);
  1076. end;
  1077. unequaln :
  1078. begin
  1079. b:=tsetconstnode(right).value_set^ <> tsetconstnode(left).value_set^;
  1080. t:=cordconstnode.create(byte(b),pasbool1type,true);
  1081. end;
  1082. equaln :
  1083. begin
  1084. b:=tsetconstnode(right).value_set^ = tsetconstnode(left).value_set^;
  1085. t:=cordconstnode.create(byte(b),pasbool1type,true);
  1086. end;
  1087. lten :
  1088. begin
  1089. b:=tsetconstnode(left).value_set^ <= tsetconstnode(right).value_set^;
  1090. t:=cordconstnode.create(byte(b),pasbool1type,true);
  1091. end;
  1092. gten :
  1093. begin
  1094. b:=tsetconstnode(left).value_set^ >= tsetconstnode(right).value_set^;
  1095. t:=cordconstnode.create(byte(b),pasbool1type,true);
  1096. end;
  1097. else
  1098. internalerror(2008022105);
  1099. end;
  1100. result:=t;
  1101. exit;
  1102. end;
  1103. { in case of expressions having no side effect, we can simplify boolean expressions
  1104. containing constants }
  1105. if is_boolean(left.resultdef) and is_boolean(right.resultdef) then
  1106. begin
  1107. if is_constboolnode(left) then
  1108. begin
  1109. if ((nodetype=andn) and (tordconstnode(left).value<>0)) or
  1110. ((nodetype=orn) and (tordconstnode(left).value=0)) or
  1111. ((nodetype=xorn) and (tordconstnode(left).value=0)) then
  1112. begin
  1113. result:=right;
  1114. right:=nil;
  1115. exit;
  1116. end
  1117. else if not(might_have_sideeffects(right)) and
  1118. (((nodetype=orn) and (tordconstnode(left).value<>0)) or
  1119. ((nodetype=andn) and (tordconstnode(left).value=0))) then
  1120. begin
  1121. result:=left;
  1122. left:=nil;
  1123. exit;
  1124. end
  1125. else if ((nodetype=xorn) and (tordconstnode(left).value<>0)) then
  1126. begin
  1127. result:=cnotnode.create(right);
  1128. right:=nil;
  1129. exit;
  1130. end
  1131. end
  1132. else if is_constboolnode(right) then
  1133. begin
  1134. if ((nodetype=andn) and (tordconstnode(right).value<>0)) or
  1135. ((nodetype=orn) and (tordconstnode(right).value=0)) or
  1136. ((nodetype=xorn) and (tordconstnode(right).value=0)) then
  1137. begin
  1138. result:=left;
  1139. left:=nil;
  1140. exit;
  1141. end
  1142. else if not(might_have_sideeffects(left)) and
  1143. (((nodetype=orn) and (tordconstnode(right).value<>0)) or
  1144. ((nodetype=andn) and (tordconstnode(right).value=0))) then
  1145. begin
  1146. result:=right;
  1147. right:=nil;
  1148. exit;
  1149. end
  1150. else if ((nodetype=xorn) and (tordconstnode(right).value<>0)) then
  1151. begin
  1152. result:=cnotnode.create(left);
  1153. left:=nil;
  1154. exit;
  1155. end
  1156. end;
  1157. end;
  1158. { slow simplifications }
  1159. if cs_opt_level2 in current_settings.optimizerswitches then
  1160. begin
  1161. { the comparison is might be expensive and the nodes are usually only
  1162. equal if some previous optimizations were done so don't check
  1163. this simplification always
  1164. }
  1165. if is_boolean(left.resultdef) and is_boolean(right.resultdef) then
  1166. begin
  1167. { transform unsigned comparisons of (v>=x) and (v<=y)
  1168. into (v-x)<=(y-x)
  1169. }
  1170. if (nodetype=andn) and
  1171. (left.nodetype in [ltn,lten,gtn,gten]) and
  1172. (right.nodetype in [ltn,lten,gtn,gten]) and
  1173. (not might_have_sideeffects(left)) and
  1174. (not might_have_sideeffects(right)) and
  1175. is_range_test(taddnode(left),taddnode(right),vl,cl,cr) then
  1176. begin
  1177. hdef:=get_unsigned_inttype(vl.resultdef);
  1178. vl:=ctypeconvnode.create_internal(vl.getcopy,hdef);
  1179. result:=caddnode.create_internal(lten,
  1180. ctypeconvnode.create_internal(caddnode.create_internal(subn,vl,cordconstnode.create(cl,hdef,false)),hdef),
  1181. cordconstnode.create(cr-cl,hdef,false));
  1182. exit;
  1183. end;
  1184. { even when short circuit boolean evaluation is active, this
  1185. optimization cannot be performed in case the node has
  1186. side effects, because this can change the result (e.g., in an
  1187. or-node that calls the same function twice and first returns
  1188. false and then true because of a global state change }
  1189. if left.isequal(right) and not might_have_sideeffects(left) then
  1190. begin
  1191. case nodetype of
  1192. andn,orn:
  1193. begin
  1194. result:=left;
  1195. left:=nil;
  1196. exit;
  1197. end;
  1198. {
  1199. xorn:
  1200. begin
  1201. result:=cordconstnode.create(0,resultdef,true);
  1202. exit;
  1203. end;
  1204. }
  1205. else
  1206. ;
  1207. end;
  1208. end
  1209. { short to full boolean evalution possible and useful? }
  1210. else if not(might_have_sideeffects(right,[mhs_exceptions])) and not(cs_full_boolean_eval in localswitches) then
  1211. begin
  1212. case nodetype of
  1213. andn,orn:
  1214. begin
  1215. { full boolean evaluation is only useful if the nodes are not too complex and if no flags/jumps must be converted,
  1216. further, we need to know the expectloc }
  1217. if (node_complexity(right)<=2) and
  1218. not(left.expectloc in [LOC_JUMP,LOC_INVALID]) and not(right.expectloc in [LOC_JUMP,LOC_INVALID]) then
  1219. begin
  1220. { we need to copy the whole tree to force another pass_1 }
  1221. include(localswitches,cs_full_boolean_eval);
  1222. result:=getcopy;
  1223. exit;
  1224. end;
  1225. end;
  1226. else
  1227. ;
  1228. end;
  1229. end
  1230. end;
  1231. if is_integer(left.resultdef) and is_integer(right.resultdef) then
  1232. begin
  1233. if (cs_opt_level3 in current_settings.optimizerswitches) and
  1234. left.isequal(right) and not might_have_sideeffects(left) then
  1235. begin
  1236. case nodetype of
  1237. andn,orn:
  1238. begin
  1239. result:=left;
  1240. left:=nil;
  1241. exit;
  1242. end;
  1243. xorn,
  1244. subn,
  1245. unequaln,
  1246. ltn,
  1247. gtn:
  1248. begin
  1249. result:=cordconstnode.create(0,resultdef,true);
  1250. exit;
  1251. end;
  1252. equaln,
  1253. lten,
  1254. gten:
  1255. begin
  1256. result:=cordconstnode.create(1,resultdef,true);
  1257. exit;
  1258. end;
  1259. else
  1260. ;
  1261. end;
  1262. end
  1263. {$ifndef jvm}
  1264. else if (nodetype=equaln) and MatchAndTransformNodesCommutative(left,right,@IsLengthZero,@TransformLengthZero,Result) then
  1265. exit
  1266. {$endif jvm}
  1267. ;
  1268. end;
  1269. { using sqr(x) for reals instead of x*x might reduces register pressure and/or
  1270. memory accesses while sqr(<real>) has no drawback }
  1271. if
  1272. {$ifdef cpufpemu}
  1273. (current_settings.fputype<>fpu_soft) and
  1274. not(cs_fp_emulation in current_settings.moduleswitches) and
  1275. {$endif cpufpemu}
  1276. (nodetype=muln) and
  1277. is_real(left.resultdef) and is_real(right.resultdef) and
  1278. left.isequal(right) and
  1279. not(might_have_sideeffects(left)) then
  1280. begin
  1281. result:=cinlinenode.create(in_sqr_real,false,left);
  1282. left:=nil;
  1283. exit;
  1284. end;
  1285. {$ifdef cpurox}
  1286. { optimize (i shl x) or (i shr (bitsizeof(i)-x)) into rol(x,i) (and different flavours with shl/shr swapped etc.) }
  1287. if (nodetype=orn)
  1288. {$ifdef m68k}
  1289. and (CPUM68K_HAS_ROLROR in cpu_capabilities[current_settings.cputype])
  1290. {$endif m68k}
  1291. {$ifndef cpu64bitalu}
  1292. and (left.resultdef.typ=orddef) and
  1293. not(torddef(left.resultdef).ordtype in [s64bit,u64bit,scurrency])
  1294. {$endif cpu64bitalu}
  1295. then
  1296. begin
  1297. if (left.nodetype=shrn) and (right.nodetype=shln) and
  1298. is_constintnode(tshlshrnode(left).right) and
  1299. is_constintnode(tshlshrnode(right).right) and
  1300. (tordconstnode(tshlshrnode(right).right).value>0) and
  1301. (tordconstnode(tshlshrnode(left).right).value>0) and
  1302. tshlshrnode(left).left.isequal(tshlshrnode(right).left) and
  1303. not(might_have_sideeffects(tshlshrnode(left).left)) then
  1304. begin
  1305. if (tordconstnode(tshlshrnode(left).right).value=
  1306. tshlshrnode(left).left.resultdef.size*8-tordconstnode(tshlshrnode(right).right).value) then
  1307. begin
  1308. result:=cinlinenode.create(in_ror_x_y,false,
  1309. ccallparanode.create(tshlshrnode(left).right,
  1310. ccallparanode.create(tshlshrnode(left).left,nil)));
  1311. tshlshrnode(left).left:=nil;
  1312. tshlshrnode(left).right:=nil;
  1313. exit;
  1314. end
  1315. else if (tordconstnode(tshlshrnode(right).right).value=
  1316. tshlshrnode(left).left.resultdef.size*8-tordconstnode(tshlshrnode(left).right).value) then
  1317. begin
  1318. result:=cinlinenode.create(in_rol_x_y,false,
  1319. ccallparanode.create(tshlshrnode(right).right,
  1320. ccallparanode.create(tshlshrnode(left).left,nil)));
  1321. tshlshrnode(left).left:=nil;
  1322. tshlshrnode(right).right:=nil;
  1323. exit;
  1324. end;
  1325. end;
  1326. if (left.nodetype=shln) and (right.nodetype=shrn) and
  1327. is_constintnode(tshlshrnode(left).right) and
  1328. is_constintnode(tshlshrnode(right).right) and
  1329. (tordconstnode(tshlshrnode(right).right).value>0) and
  1330. (tordconstnode(tshlshrnode(left).right).value>0) and
  1331. tshlshrnode(left).left.isequal(tshlshrnode(right).left) and
  1332. not(might_have_sideeffects(tshlshrnode(left).left)) then
  1333. begin
  1334. if (tordconstnode(tshlshrnode(left).right).value=
  1335. tshlshrnode(left).left.resultdef.size*8-tordconstnode(tshlshrnode(right).right).value)
  1336. then
  1337. begin
  1338. result:=cinlinenode.create(in_rol_x_y,false,
  1339. ccallparanode.create(tshlshrnode(left).right,
  1340. ccallparanode.create(tshlshrnode(left).left,nil)));
  1341. tshlshrnode(left).left:=nil;
  1342. tshlshrnode(left).right:=nil;
  1343. exit;
  1344. end
  1345. else if (tordconstnode(tshlshrnode(right).right).value=
  1346. tshlshrnode(left).left.resultdef.size*8-tordconstnode(tshlshrnode(left).right).value)
  1347. then
  1348. begin
  1349. result:=cinlinenode.create(in_ror_x_y,false,
  1350. ccallparanode.create(tshlshrnode(right).right,
  1351. ccallparanode.create(tshlshrnode(left).left,nil)));
  1352. tshlshrnode(left).left:=nil;
  1353. tshlshrnode(right).right:=nil;
  1354. exit;
  1355. end;
  1356. end;
  1357. end;
  1358. {$endif cpurox}
  1359. end;
  1360. end;
  1361. function taddnode.dogetcopy: tnode;
  1362. var
  1363. n: taddnode;
  1364. begin
  1365. n:=taddnode(inherited dogetcopy);
  1366. n.resultrealdef:=resultrealdef;
  1367. result:=n;
  1368. end;
  1369. function taddnode.docompare(p: tnode): boolean;
  1370. begin
  1371. result:=
  1372. inherited docompare(p) and
  1373. equal_defs(taddnode(p).resultrealdef,resultrealdef);
  1374. end;
  1375. function taddnode.pass_typecheck:tnode;
  1376. begin
  1377. { This function is small to keep the stack small for recursive of
  1378. large + operations }
  1379. typecheckpass(left);
  1380. typecheckpass(right);
  1381. result:=pass_typecheck_internal;
  1382. end;
  1383. function taddnode.pass_typecheck_internal:tnode;
  1384. var
  1385. hp : tnode;
  1386. rd,ld,nd : tdef;
  1387. hsym : tfieldvarsym;
  1388. llow,lhigh,
  1389. rlow,rhigh : tconstexprint;
  1390. strtype : tstringtype;
  1391. res,
  1392. b : boolean;
  1393. lt,rt : tnodetype;
  1394. ot : tnodetype;
  1395. {$ifdef state_tracking}
  1396. factval : Tnode;
  1397. change : boolean;
  1398. {$endif}
  1399. function maybe_cast_ordconst(var n: tnode; adef: tdef): boolean;
  1400. begin
  1401. result:=(tordconstnode(n).value>=torddef(adef).low) and
  1402. (tordconstnode(n).value<=torddef(adef).high);
  1403. if result then
  1404. inserttypeconv(n,adef);
  1405. end;
  1406. function maybe_convert_to_insert:tnode;
  1407. function element_count(arrconstr: tarrayconstructornode):asizeint;
  1408. begin
  1409. result:=0;
  1410. while assigned(arrconstr) do
  1411. begin
  1412. if arrconstr.nodetype=arrayconstructorrangen then
  1413. internalerror(2018052501);
  1414. inc(result);
  1415. arrconstr:=tarrayconstructornode(tarrayconstructornode(arrconstr).right);
  1416. end;
  1417. end;
  1418. var
  1419. elem : tnode;
  1420. para : tcallparanode;
  1421. isarrconstrl,
  1422. isarrconstrr : boolean;
  1423. index : asizeint;
  1424. begin
  1425. result:=nil;
  1426. isarrconstrl:=left.nodetype=arrayconstructorn;
  1427. isarrconstrr:=right.nodetype=arrayconstructorn;
  1428. if not assigned(aktassignmentnode) or
  1429. (aktassignmentnode.right<>self) or
  1430. not(
  1431. isarrconstrl or
  1432. isarrconstrr
  1433. ) or
  1434. not(
  1435. left.isequal(aktassignmentnode.left) or
  1436. right.isequal(aktassignmentnode.left)
  1437. ) or
  1438. not valid_for_var(aktassignmentnode.left,false) or
  1439. (isarrconstrl and (element_count(tarrayconstructornode(left))>1)) or
  1440. (isarrconstrr and (element_count(tarrayconstructornode(right))>1)) then
  1441. exit;
  1442. if isarrconstrl then
  1443. begin
  1444. index:=0;
  1445. elem:=tarrayconstructornode(left).left;
  1446. tarrayconstructornode(left).left:=nil;
  1447. end
  1448. else
  1449. begin
  1450. index:=high(asizeint);
  1451. elem:=tarrayconstructornode(right).left;
  1452. tarrayconstructornode(right).left:=nil;
  1453. end;
  1454. { we use the fact that insert() caps the index to avoid a copy }
  1455. para:=ccallparanode.create(
  1456. cordconstnode.create(index,sizesinttype,false),
  1457. ccallparanode.create(
  1458. aktassignmentnode.left.getcopy,
  1459. ccallparanode.create(
  1460. elem,nil)));
  1461. result:=cinlinenode.create(in_insert_x_y_z,false,para);
  1462. include(aktassignmentnode.flags,nf_assign_done_in_right);
  1463. end;
  1464. begin
  1465. result:=nil;
  1466. rlow:=0;
  1467. llow:=0;
  1468. rhigh:=0;
  1469. lhigh:=0;
  1470. { avoid any problems with type parameters later on }
  1471. if is_typeparam(left.resultdef) or is_typeparam(right.resultdef) then
  1472. begin
  1473. resultdef:=cundefinedtype;
  1474. exit;
  1475. end;
  1476. { both left and right need to be valid }
  1477. set_varstate(left,vs_read,[vsf_must_be_valid]);
  1478. set_varstate(right,vs_read,[vsf_must_be_valid]);
  1479. if codegenerror then
  1480. exit;
  1481. { tp procvar support. Omit for converted assigned() nodes }
  1482. if not (nf_load_procvar in flags) then
  1483. begin
  1484. maybe_call_procvar(left,true);
  1485. maybe_call_procvar(right,true);
  1486. end
  1487. else
  1488. if not (nodetype in [equaln,unequaln]) then
  1489. InternalError(2013091601);
  1490. { allow operator overloading }
  1491. hp:=self;
  1492. if is_array_constructor(left.resultdef) or is_array_constructor(right.resultdef) then
  1493. begin
  1494. { check whether there is a suitable operator for the array constructor
  1495. (but only if the "+" array operator isn't used), if not fall back to sets }
  1496. if (
  1497. (nodetype<>addn) or
  1498. not (m_array_operators in current_settings.modeswitches) or
  1499. (is_array_constructor(left.resultdef) and not is_dynamic_array(right.resultdef)) or
  1500. (not is_dynamic_array(left.resultdef) and is_array_constructor(right.resultdef))
  1501. ) and
  1502. not isbinaryoverloaded(hp,[ocf_check_only]) then
  1503. begin
  1504. if is_array_constructor(left.resultdef) then
  1505. begin
  1506. arrayconstructor_to_set(left);
  1507. typecheckpass(left);
  1508. end;
  1509. if is_array_constructor(right.resultdef) then
  1510. begin
  1511. arrayconstructor_to_set(right);
  1512. typecheckpass(right);
  1513. end;
  1514. end;
  1515. end;
  1516. if is_dynamic_array(left.resultdef) and is_dynamic_array(right.resultdef) and
  1517. (nodetype=addn) and
  1518. (m_array_operators in current_settings.modeswitches) and
  1519. isbinaryoverloaded(hp,[ocf_check_non_overloadable,ocf_check_only]) then
  1520. message3(parser_w_operator_overloaded_hidden_3,left.resultdef.typename,arraytokeninfo[_PLUS].str,right.resultdef.typename);
  1521. if isbinaryoverloaded(hp,[]) then
  1522. begin
  1523. result:=hp;
  1524. exit;
  1525. end;
  1526. { Stop checking when an error was found in the operator checking }
  1527. if codegenerror then
  1528. begin
  1529. result:=cerrornode.create;
  1530. exit;
  1531. end;
  1532. { Kylix allows enum+ordconstn in an enum type declaration, we need to do
  1533. the conversion here before the constant folding }
  1534. if (m_delphi in current_settings.modeswitches) and
  1535. (blocktype in [bt_type,bt_const_type,bt_var_type]) then
  1536. begin
  1537. if (left.resultdef.typ=enumdef) and
  1538. (right.resultdef.typ=orddef) then
  1539. begin
  1540. { insert explicit typecast to default signed int }
  1541. left:=ctypeconvnode.create_internal(left,sinttype);
  1542. typecheckpass(left);
  1543. end
  1544. else
  1545. if (left.resultdef.typ=orddef) and
  1546. (right.resultdef.typ=enumdef) then
  1547. begin
  1548. { insert explicit typecast to default signed int }
  1549. right:=ctypeconvnode.create_internal(right,sinttype);
  1550. typecheckpass(right);
  1551. end;
  1552. end;
  1553. { is one a real float, then both need to be floats, this
  1554. need to be done before the constant folding so constant
  1555. operation on a float and int are also handled }
  1556. {$ifdef x86}
  1557. { use extended as default real type only when the x87 fpu is used }
  1558. {$if defined(i386) or defined(i8086)}
  1559. if not(current_settings.fputype=fpu_x87) then
  1560. resultrealdef:=s64floattype
  1561. else
  1562. resultrealdef:=pbestrealtype^;
  1563. {$endif i386 or i8086}
  1564. {$ifdef x86_64}
  1565. { x86-64 has no x87 only mode, so use always double as default }
  1566. resultrealdef:=s64floattype;
  1567. {$endif x86_6}
  1568. {$else not x86}
  1569. resultrealdef:=pbestrealtype^;
  1570. {$endif not x86}
  1571. if (right.resultdef.typ=floatdef) or (left.resultdef.typ=floatdef) then
  1572. begin
  1573. { when both floattypes are already equal then use that
  1574. floattype for results }
  1575. if (right.resultdef.typ=floatdef) and
  1576. (left.resultdef.typ=floatdef) and
  1577. (tfloatdef(left.resultdef).floattype=tfloatdef(right.resultdef).floattype) then
  1578. begin
  1579. if cs_excessprecision in current_settings.localswitches then
  1580. resultrealdef:=pbestrealtype^
  1581. else
  1582. resultrealdef:=left.resultdef
  1583. end
  1584. { when there is a currency type then use currency, but
  1585. only when currency is defined as float }
  1586. else
  1587. if (is_currency(right.resultdef) or
  1588. is_currency(left.resultdef)) and
  1589. ((s64currencytype.typ = floatdef) or
  1590. (nodetype <> slashn)) then
  1591. begin
  1592. resultrealdef:=s64currencytype;
  1593. inserttypeconv(right,resultrealdef);
  1594. inserttypeconv(left,resultrealdef);
  1595. end
  1596. else
  1597. begin
  1598. resultrealdef:=getbestreal(left.resultdef,right.resultdef);
  1599. inserttypeconv(right,resultrealdef);
  1600. inserttypeconv(left,resultrealdef);
  1601. end;
  1602. end;
  1603. { If both operands are constant and there is a unicodestring
  1604. or unicodestring then convert everything to unicodestring }
  1605. if is_constnode(right) and is_constnode(left) and
  1606. (is_unicodestring(right.resultdef) or
  1607. is_unicodestring(left.resultdef)) then
  1608. begin
  1609. inserttypeconv(right,cunicodestringtype);
  1610. inserttypeconv(left,cunicodestringtype);
  1611. end;
  1612. { If both operands are constant and there is a widechar
  1613. or widestring then convert everything to widestring. This
  1614. allows constant folding like char+widechar }
  1615. if is_constnode(right) and is_constnode(left) and
  1616. (is_widestring(right.resultdef) or
  1617. is_widestring(left.resultdef) or
  1618. is_widechar(right.resultdef) or
  1619. is_widechar(left.resultdef)) then
  1620. begin
  1621. inserttypeconv(right,cwidestringtype);
  1622. inserttypeconv(left,cwidestringtype);
  1623. end;
  1624. { load easier access variables }
  1625. rd:=right.resultdef;
  1626. ld:=left.resultdef;
  1627. rt:=right.nodetype;
  1628. lt:=left.nodetype;
  1629. { 4 character constant strings are compatible with orddef }
  1630. { in macpas mode (become cardinals) }
  1631. if (m_mac in current_settings.modeswitches) and
  1632. { only allow for comparisons, additions etc are }
  1633. { normally program errors }
  1634. (nodetype in [ltn,lten,gtn,gten,unequaln,equaln]) and
  1635. (((lt=stringconstn) and
  1636. (tstringconstnode(left).len=4) and
  1637. (rd.typ=orddef)) or
  1638. ((rt=stringconstn) and
  1639. (tstringconstnode(right).len=4) and
  1640. (ld.typ=orddef))) then
  1641. begin
  1642. if (rt=stringconstn) then
  1643. begin
  1644. inserttypeconv(right,u32inttype);
  1645. rt:=right.nodetype;
  1646. rd:=right.resultdef;
  1647. end
  1648. else
  1649. begin
  1650. inserttypeconv(left,u32inttype);
  1651. lt:=left.nodetype;
  1652. ld:=left.resultdef;
  1653. end;
  1654. end;
  1655. { but an int/int gives real/real! }
  1656. if (nodetype=slashn) and not(is_vector(left.resultdef)) and not(is_vector(right.resultdef)) then
  1657. begin
  1658. if is_currency(left.resultdef) and
  1659. is_currency(right.resultdef) then
  1660. { In case of currency, converting to float means dividing by 10000 }
  1661. { However, since this is already a division, both divisions by }
  1662. { 10000 are eliminated when we divide the results -> we can skip }
  1663. { them. }
  1664. if s64currencytype.typ = floatdef then
  1665. begin
  1666. { there's no s64comptype or so, how do we avoid the type conversion?
  1667. left.resultdef := s64comptype;
  1668. right.resultdef := s64comptype; }
  1669. end
  1670. else
  1671. begin
  1672. left.resultdef := s64inttype;
  1673. right.resultdef := s64inttype;
  1674. end;
  1675. if current_settings.fputype=fpu_none then
  1676. begin
  1677. Message(parser_e_unsupported_real);
  1678. result:=cerrornode.create;
  1679. exit;
  1680. end
  1681. else
  1682. begin
  1683. inserttypeconv(right,resultrealdef);
  1684. inserttypeconv(left,resultrealdef);
  1685. end;
  1686. end
  1687. { if both are orddefs then check sub types }
  1688. else if (ld.typ=orddef) and (rd.typ=orddef) then
  1689. begin
  1690. { set for & and | operations in macpas mode: they only work on }
  1691. { booleans, and always short circuit evaluation }
  1692. if (nf_short_bool in flags) then
  1693. begin
  1694. if not is_boolean(ld) then
  1695. begin
  1696. inserttypeconv(left,pasbool1type);
  1697. ld := left.resultdef;
  1698. end;
  1699. if not is_boolean(rd) then
  1700. begin
  1701. inserttypeconv(right,pasbool1type);
  1702. rd := right.resultdef;
  1703. end;
  1704. end;
  1705. { 2 booleans? }
  1706. if (is_boolean(ld) and is_boolean(rd)) then
  1707. begin
  1708. case nodetype of
  1709. xorn,
  1710. andn,
  1711. orn:
  1712. begin
  1713. { in case of xor, or 'and' with full and cbool: convert both to Pascal bool and then
  1714. perform the xor/and to prevent issues with "longbool(1) and/xor
  1715. longbool(2)" }
  1716. if (is_cbool(ld) or is_cbool(rd)) and
  1717. ((nodetype=xorn) or
  1718. ((nodetype=andn) and
  1719. ((cs_full_boolean_eval in current_settings.localswitches) or
  1720. not(nf_short_bool in flags)
  1721. )
  1722. )
  1723. ) then
  1724. begin
  1725. resultdef:=nil;
  1726. if is_cbool(ld) then
  1727. begin
  1728. inserttypeconv(left,pasbool8type);
  1729. { inserttypeconv might already simplify
  1730. the typeconvnode after insertion,
  1731. thus we need to check if it still
  1732. really is a typeconv node }
  1733. if left is ttypeconvnode then
  1734. ttypeconvnode(left).convtype:=tc_bool_2_bool;
  1735. if not is_cbool(rd) or
  1736. (ld.size>=rd.size) then
  1737. resultdef:=ld;
  1738. end;
  1739. if is_cbool(rd) then
  1740. begin
  1741. inserttypeconv(right,pasbool8type);
  1742. { inserttypeconv might already simplify
  1743. the typeconvnode after insertion,
  1744. thus we need to check if it still
  1745. really is a typeconv node }
  1746. if right is ttypeconvnode then
  1747. ttypeconvnode(right).convtype:=tc_bool_2_bool;
  1748. if not assigned(resultdef) then
  1749. resultdef:=rd;
  1750. end;
  1751. result:=ctypeconvnode.create_explicit(caddnode.create(nodetype,left,right),resultdef);
  1752. ttypeconvnode(result).convtype:=tc_bool_2_bool;
  1753. left:=nil;
  1754. right:=nil;
  1755. exit;
  1756. end;
  1757. { Make sides equal to the largest boolean }
  1758. if (torddef(left.resultdef).size>torddef(right.resultdef).size) or
  1759. (is_cbool(left.resultdef) and not is_cbool(right.resultdef)) then
  1760. begin
  1761. right:=ctypeconvnode.create_internal(right,left.resultdef);
  1762. ttypeconvnode(right).convtype:=tc_bool_2_bool;
  1763. typecheckpass(right);
  1764. end
  1765. else if (torddef(left.resultdef).size<torddef(right.resultdef).size) or
  1766. (not is_cbool(left.resultdef) and is_cbool(right.resultdef)) then
  1767. begin
  1768. left:=ctypeconvnode.create_internal(left,right.resultdef);
  1769. ttypeconvnode(left).convtype:=tc_bool_2_bool;
  1770. typecheckpass(left);
  1771. end;
  1772. end;
  1773. ltn,
  1774. lten,
  1775. gtn,
  1776. gten:
  1777. begin
  1778. { convert both to pasbool to perform the comparison (so
  1779. that longbool(4) = longbool(2), since both represent
  1780. "true" }
  1781. inserttypeconv(left,pasbool1type);
  1782. inserttypeconv(right,pasbool1type);
  1783. end;
  1784. unequaln,
  1785. equaln:
  1786. begin
  1787. if not(cs_full_boolean_eval in current_settings.localswitches) or
  1788. (nf_short_bool in flags) then
  1789. begin
  1790. { Remove any compares with constants }
  1791. if (left.nodetype=ordconstn) then
  1792. begin
  1793. hp:=right;
  1794. b:=(tordconstnode(left).value<>0);
  1795. ot:=nodetype;
  1796. left.free;
  1797. left:=nil;
  1798. right:=nil;
  1799. if (not(b) and (ot=equaln)) or
  1800. (b and (ot=unequaln)) then
  1801. begin
  1802. hp:=cnotnode.create(hp);
  1803. end;
  1804. result:=hp;
  1805. exit;
  1806. end;
  1807. if (right.nodetype=ordconstn) then
  1808. begin
  1809. hp:=left;
  1810. b:=(tordconstnode(right).value<>0);
  1811. ot:=nodetype;
  1812. right.free;
  1813. right:=nil;
  1814. left:=nil;
  1815. if (not(b) and (ot=equaln)) or
  1816. (b and (ot=unequaln)) then
  1817. begin
  1818. hp:=cnotnode.create(hp);
  1819. end;
  1820. result:=hp;
  1821. exit;
  1822. end;
  1823. end;
  1824. { Delphi-compatibility: convert both to pasbool to
  1825. perform the equality comparison }
  1826. inserttypeconv(left,pasbool1type);
  1827. inserttypeconv(right,pasbool1type);
  1828. end;
  1829. else
  1830. begin
  1831. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1832. result:=cnothingnode.create;
  1833. exit;
  1834. end;
  1835. end;
  1836. end
  1837. { Both are chars? }
  1838. else if is_char(rd) and is_char(ld) then
  1839. begin
  1840. if nodetype=addn then
  1841. begin
  1842. resultdef:=cshortstringtype;
  1843. if not(is_constcharnode(left) and is_constcharnode(right)) then
  1844. begin
  1845. inserttypeconv(left,cshortstringtype);
  1846. {$ifdef addstringopt}
  1847. hp := genaddsstringcharoptnode(self);
  1848. result := hp;
  1849. exit;
  1850. {$endif addstringopt}
  1851. end
  1852. end
  1853. else if not(nodetype in [ltn,lten,gtn,gten,unequaln,equaln]) then
  1854. begin
  1855. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  1856. result:=cnothingnode.create;
  1857. exit;
  1858. end;
  1859. end
  1860. { There is a widechar? }
  1861. else if is_widechar(rd) or is_widechar(ld) then
  1862. begin
  1863. { widechar+widechar gives unicodestring }
  1864. if nodetype=addn then
  1865. begin
  1866. inserttypeconv(left,cunicodestringtype);
  1867. if (torddef(rd).ordtype<>uwidechar) then
  1868. inserttypeconv(right,cwidechartype);
  1869. resultdef:=cunicodestringtype;
  1870. end
  1871. else
  1872. begin
  1873. if (torddef(ld).ordtype<>uwidechar) then
  1874. inserttypeconv(left,cwidechartype);
  1875. if (torddef(rd).ordtype<>uwidechar) then
  1876. inserttypeconv(right,cwidechartype);
  1877. end;
  1878. end
  1879. { is there a currency type ? }
  1880. else if ((torddef(rd).ordtype=scurrency) or (torddef(ld).ordtype=scurrency)) then
  1881. begin
  1882. if (torddef(ld).ordtype<>scurrency) then
  1883. inserttypeconv(left,s64currencytype);
  1884. if (torddef(rd).ordtype<>scurrency) then
  1885. inserttypeconv(right,s64currencytype);
  1886. end
  1887. { leave some constant integer expressions alone in case the
  1888. resultdef of the integer types doesn't influence the outcome,
  1889. because the forced type conversions below can otherwise result
  1890. in unexpected results (such as high(qword)<high(int64) returning
  1891. true because high(qword) gets converted to int64) }
  1892. else if is_integer(ld) and is_integer(rd) and
  1893. (lt=ordconstn) and (rt=ordconstn) and
  1894. (nodetype in [equaln,unequaln,gtn,gten,ltn,lten]) then
  1895. begin
  1896. end
  1897. { "and" does't care about the sign of integers }
  1898. { "xor", "or" and compares don't need extension to native int }
  1899. { size either as long as both values are signed or unsigned }
  1900. { "xor" and "or" also don't care about the sign if the values }
  1901. { occupy an entire register }
  1902. { don't do it if either type is 64 bit (except for "and"), }
  1903. { since in that case we can't safely find a "common" type }
  1904. else if is_integer(ld) and is_integer(rd) and
  1905. ((nodetype=andn) or
  1906. ((nodetype in [orn,xorn,equaln,unequaln,gtn,gten,ltn,lten]) and
  1907. not is_64bitint(ld) and not is_64bitint(rd) and
  1908. (is_signed(ld)=is_signed(rd)))) then
  1909. begin
  1910. { Delphi-compatible: prefer unsigned type for "and", when the
  1911. unsigned type is bigger than the signed one, and also bigger
  1912. than min(native_int, 32-bit) }
  1913. if (is_oversizedint(rd) or is_nativeint(rd) or is_32bitint(rd)) and
  1914. (rd.size>=ld.size) and
  1915. not is_signed(rd) and is_signed(ld) then
  1916. inserttypeconv_internal(left,rd)
  1917. else if (is_oversizedint(ld) or is_nativeint(ld) or is_32bitint(ld)) and
  1918. (ld.size>=rd.size) and
  1919. not is_signed(ld) and is_signed(rd) then
  1920. inserttypeconv_internal(right,ld)
  1921. else
  1922. begin
  1923. { not to left right.resultdef, because that may
  1924. cause a range error if left and right's def don't
  1925. completely overlap }
  1926. nd:=get_common_intdef(torddef(ld),torddef(rd),true);
  1927. inserttypeconv(left,nd);
  1928. inserttypeconv(right,nd);
  1929. end;
  1930. end
  1931. { don't extend (sign-mismatched) comparisons if either side is a constant
  1932. whose value is within range of opposite side }
  1933. else if is_integer(ld) and is_integer(rd) and
  1934. (nodetype in [equaln,unequaln,gtn,gten,ltn,lten]) and
  1935. (is_signed(ld)<>is_signed(rd)) and
  1936. (
  1937. ((lt=ordconstn) and maybe_cast_ordconst(left,rd)) or
  1938. ((rt=ordconstn) and maybe_cast_ordconst(right,ld))
  1939. ) then
  1940. begin
  1941. { done here }
  1942. end
  1943. { is there a signed 64 bit type ? }
  1944. else if ((torddef(rd).ordtype=s64bit) or (torddef(ld).ordtype=s64bit)) then
  1945. begin
  1946. if (torddef(ld).ordtype<>s64bit) then
  1947. inserttypeconv(left,s64inttype);
  1948. if (torddef(rd).ordtype<>s64bit) then
  1949. inserttypeconv(right,s64inttype);
  1950. end
  1951. { is there a unsigned 64 bit type ? }
  1952. else if ((torddef(rd).ordtype=u64bit) or (torddef(ld).ordtype=u64bit)) then
  1953. begin
  1954. if (torddef(ld).ordtype<>u64bit) then
  1955. inserttypeconv(left,u64inttype);
  1956. if (torddef(rd).ordtype<>u64bit) then
  1957. inserttypeconv(right,u64inttype);
  1958. end
  1959. { is there a larger int? }
  1960. else if is_oversizedint(rd) or is_oversizedint(ld) then
  1961. begin
  1962. nd:=get_common_intdef(torddef(ld),torddef(rd),false);
  1963. inserttypeconv(right,nd);
  1964. inserttypeconv(left,nd);
  1965. end
  1966. { is there a native unsigned int? }
  1967. else if is_nativeuint(rd) or is_nativeuint(ld) then
  1968. begin
  1969. { convert positive constants to uinttype }
  1970. if (not is_nativeuint(ld)) and
  1971. is_constintnode(left) and
  1972. (tordconstnode(left).value >= 0) then
  1973. inserttypeconv(left,uinttype);
  1974. if (not is_nativeuint(rd)) and
  1975. is_constintnode(right) and
  1976. (tordconstnode(right).value >= 0) then
  1977. inserttypeconv(right,uinttype);
  1978. { when one of the operand is signed or the operation is subn then perform
  1979. the operation in a larger signed type, can't use rd/ld here because there
  1980. could be already typeconvs inserted.
  1981. This is compatible with the code below for other unsigned types (PFV) }
  1982. if is_signed(left.resultdef) or
  1983. is_signed(right.resultdef) or
  1984. (nodetype=subn) then
  1985. begin
  1986. if nodetype<>subn then
  1987. CGMessage(type_h_mixed_signed_unsigned);
  1988. { mark as internal in case added for a subn, so }
  1989. { ttypeconvnode.simplify can remove the larger }
  1990. { typecast again if semantically correct. Even }
  1991. { if we could detect that here already, we }
  1992. { mustn't do it here because that would change }
  1993. { overload choosing behaviour etc. The code in }
  1994. { ncnv.pas is run after that is already decided }
  1995. if (not is_signed(left.resultdef) and
  1996. not is_signed(right.resultdef)) or
  1997. (nodetype in [orn,xorn]) then
  1998. include(flags,nf_internal);
  1999. { get next larger signed int type }
  2000. nd:=get_common_intdef(torddef(sinttype),torddef(uinttype),false);
  2001. inserttypeconv(left,nd);
  2002. inserttypeconv(right,nd);
  2003. end
  2004. else
  2005. begin
  2006. if not is_nativeuint(left.resultdef) then
  2007. inserttypeconv(left,uinttype);
  2008. if not is_nativeuint(right.resultdef) then
  2009. inserttypeconv(right,uinttype);
  2010. end;
  2011. end
  2012. { generic ord conversion is sinttype }
  2013. else
  2014. begin
  2015. { When there is a signed type or there is a minus operation
  2016. we convert to signed int. Otherwise (both are unsigned) we keep
  2017. the result also unsigned. This is compatible with Delphi (PFV) }
  2018. if is_signed(ld) or
  2019. is_signed(rd) or
  2020. (nodetype=subn) then
  2021. begin
  2022. inserttypeconv(right,sinttype);
  2023. inserttypeconv(left,sinttype);
  2024. end
  2025. else
  2026. begin
  2027. inserttypeconv(right,uinttype);
  2028. inserttypeconv(left,uinttype);
  2029. end;
  2030. end;
  2031. end
  2032. { if both are floatdefs, conversion is already done before constant folding }
  2033. else if (ld.typ=floatdef) then
  2034. begin
  2035. if not(nodetype in [addn,subn,muln,slashn,equaln,unequaln,ltn,lten,gtn,gten]) then
  2036. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  2037. end
  2038. { left side a setdef, must be before string processing,
  2039. else array constructor can be seen as array of char (PFV) }
  2040. else if (ld.typ=setdef) then
  2041. begin
  2042. if not(nodetype in [addn,subn,symdifn,muln,equaln,unequaln,lten,gten]) then
  2043. CGMessage(type_e_set_operation_unknown);
  2044. { right must either be a set or a set element }
  2045. if (rd.typ<>setdef) and
  2046. (rt<>setelementn) then
  2047. CGMessage(type_e_mismatch)
  2048. { Make operands the same setdef. If one's elementtype fits }
  2049. { entirely inside the other's, pick the one with the largest }
  2050. { range. Otherwise create a new setdef with a range which }
  2051. { can contain both. }
  2052. else if not(equal_defs(ld,rd)) then
  2053. begin
  2054. { note: ld cannot be an empty set with elementdef=nil in }
  2055. { case right is not a set, arrayconstructor_to_set takes }
  2056. { care of that }
  2057. { 1: rd is a set with an assigned elementdef, and ld is }
  2058. { either an empty set without elementdef or a set whose }
  2059. { elementdef fits in rd's elementdef -> convert to rd }
  2060. if ((rd.typ=setdef) and
  2061. assigned(tsetdef(rd).elementdef) and
  2062. (not assigned(tsetdef(ld).elementdef) or
  2063. is_in_limit(ld,rd))) then
  2064. inserttypeconv(left,rd)
  2065. { 2: rd is either an empty set without elementdef or a set }
  2066. { whose elementdef fits in ld's elementdef, or a set }
  2067. { element whose def fits in ld's elementdef -> convert }
  2068. { to ld. ld's elementdef can't be nil here, is caught }
  2069. { previous case and "note:" above }
  2070. else if ((rd.typ=setdef) and
  2071. (not assigned(tsetdef(rd).elementdef) or
  2072. is_in_limit(rd,ld))) or
  2073. ((rd.typ<>setdef) and
  2074. is_in_limit(rd,tsetdef(ld).elementdef)) then
  2075. if (rd.typ=setdef) then
  2076. inserttypeconv(right,ld)
  2077. else
  2078. inserttypeconv(right,tsetdef(ld).elementdef)
  2079. { 3: otherwise create setdef which encompasses both, taking }
  2080. { into account empty sets without elementdef }
  2081. else
  2082. begin
  2083. if assigned(tsetdef(ld).elementdef) then
  2084. begin
  2085. llow:=tsetdef(ld).setbase;
  2086. lhigh:=tsetdef(ld).setmax;
  2087. end;
  2088. if (rd.typ=setdef) then
  2089. if assigned(tsetdef(rd).elementdef) then
  2090. begin
  2091. rlow:=tsetdef(rd).setbase;
  2092. rhigh:=tsetdef(rd).setmax;
  2093. end
  2094. else
  2095. begin
  2096. { ld's elementdef must have been valid }
  2097. rlow:=llow;
  2098. rhigh:=lhigh;
  2099. end
  2100. else
  2101. getrange(rd,rlow,rhigh);
  2102. if not assigned(tsetdef(ld).elementdef) then
  2103. begin
  2104. llow:=rlow;
  2105. lhigh:=rhigh;
  2106. end;
  2107. nd:=csetdef.create(tsetdef(ld).elementdef,min(llow,rlow).svalue,max(lhigh,rhigh).svalue,true);
  2108. inserttypeconv(left,nd);
  2109. if (rd.typ=setdef) then
  2110. inserttypeconv(right,nd)
  2111. else
  2112. inserttypeconv(right,tsetdef(nd).elementdef);
  2113. end;
  2114. end;
  2115. end
  2116. { pointer comparision and subtraction }
  2117. else if (
  2118. (rd.typ=pointerdef) and (ld.typ=pointerdef)
  2119. ) or
  2120. { compare/add pchar to variable (not stringconst) char arrays
  2121. by addresses like BP/Delphi }
  2122. (
  2123. (nodetype in [equaln,unequaln,subn,addn]) and
  2124. (
  2125. ((is_pchar(ld) or (lt=niln)) and is_chararray(rd) and (rt<>stringconstn)) or
  2126. ((is_pchar(rd) or (rt=niln)) and is_chararray(ld) and (lt<>stringconstn))
  2127. )
  2128. ) then
  2129. begin
  2130. { convert char array to pointer }
  2131. if is_chararray(rd) then
  2132. begin
  2133. inserttypeconv(right,charpointertype);
  2134. rd:=right.resultdef;
  2135. end
  2136. else if is_chararray(ld) then
  2137. begin
  2138. inserttypeconv(left,charpointertype);
  2139. ld:=left.resultdef;
  2140. end;
  2141. case nodetype of
  2142. equaln,unequaln :
  2143. begin
  2144. if is_voidpointer(right.resultdef) then
  2145. inserttypeconv(right,left.resultdef)
  2146. else if is_voidpointer(left.resultdef) then
  2147. inserttypeconv(left,right.resultdef)
  2148. else if not(equal_defs(ld,rd)) then
  2149. IncompatibleTypes(ld,rd);
  2150. { now that the type checking is done, convert both to charpointer, }
  2151. { because methodpointers are 8 bytes even though only the first 4 }
  2152. { bytes must be compared. This can happen here if we are in }
  2153. { TP/Delphi mode, because there @methodpointer = voidpointer (but }
  2154. { a voidpointer of 8 bytes). A conversion to voidpointer would be }
  2155. { optimized away, since the result already was a voidpointer, so }
  2156. { use a charpointer instead (JM) }
  2157. {$if defined(jvm)}
  2158. inserttypeconv_internal(left,java_jlobject);
  2159. inserttypeconv_internal(right,java_jlobject);
  2160. {$elseif defined(i8086)}
  2161. if is_hugepointer(left.resultdef) then
  2162. inserttypeconv_internal(left,charhugepointertype)
  2163. else if is_farpointer(left.resultdef) then
  2164. inserttypeconv_internal(left,charfarpointertype)
  2165. else
  2166. inserttypeconv_internal(left,charnearpointertype);
  2167. if is_hugepointer(right.resultdef) then
  2168. inserttypeconv_internal(right,charhugepointertype)
  2169. else if is_farpointer(right.resultdef) then
  2170. inserttypeconv_internal(right,charfarpointertype)
  2171. else
  2172. inserttypeconv_internal(right,charnearpointertype);
  2173. {$else}
  2174. inserttypeconv_internal(left,charpointertype);
  2175. inserttypeconv_internal(right,charpointertype);
  2176. {$endif jvm}
  2177. end;
  2178. ltn,lten,gtn,gten:
  2179. begin
  2180. if (cs_extsyntax in current_settings.moduleswitches) or
  2181. (nf_internal in flags) then
  2182. begin
  2183. if is_voidpointer(right.resultdef) then
  2184. inserttypeconv(right,left.resultdef)
  2185. else if is_voidpointer(left.resultdef) then
  2186. inserttypeconv(left,right.resultdef)
  2187. else if not(equal_defs(ld,rd)) then
  2188. IncompatibleTypes(ld,rd);
  2189. end
  2190. else
  2191. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  2192. end;
  2193. subn:
  2194. begin
  2195. if (cs_extsyntax in current_settings.moduleswitches) or
  2196. (nf_internal in flags) then
  2197. begin
  2198. if is_voidpointer(right.resultdef) then
  2199. begin
  2200. if is_big_untyped_addrnode(right) then
  2201. CGMessage1(type_w_untyped_arithmetic_unportable,node2opstr(nodetype));
  2202. inserttypeconv(right,left.resultdef)
  2203. end
  2204. else if is_voidpointer(left.resultdef) then
  2205. inserttypeconv(left,right.resultdef)
  2206. else if not(equal_defs(ld,rd)) then
  2207. IncompatibleTypes(ld,rd);
  2208. end
  2209. else
  2210. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  2211. if not(nf_has_pointerdiv in flags) and
  2212. (tpointerdef(rd).pointeddef.size>1) then
  2213. begin
  2214. hp:=getcopy;
  2215. include(hp.flags,nf_has_pointerdiv);
  2216. result:=cmoddivnode.create(divn,hp,
  2217. cordconstnode.create(tpointerdef(rd).pointeddef.size,tpointerdef(rd).pointer_subtraction_result_type,false));
  2218. end;
  2219. resultdef:=tpointerdef(rd).pointer_subtraction_result_type;
  2220. exit;
  2221. end;
  2222. else
  2223. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  2224. end;
  2225. end
  2226. { is one of the operands a string?,
  2227. chararrays are also handled as strings (after conversion), also take
  2228. care of chararray+chararray and chararray+char.
  2229. Note: Must be done after pointerdef+pointerdef has been checked, else
  2230. pchar is converted to string }
  2231. else if (rd.typ=stringdef) or
  2232. (ld.typ=stringdef) or
  2233. { stringconstn's can be arraydefs }
  2234. (lt=stringconstn) or
  2235. (rt=stringconstn) or
  2236. ((is_pchar(rd) or is_chararray(rd) or is_char(rd) or is_open_chararray(rd) or
  2237. is_pwidechar(rd) or is_widechararray(rd) or is_widechar(rd) or is_open_widechararray(rd)) and
  2238. (is_pchar(ld) or is_chararray(ld) or is_char(ld) or is_open_chararray(ld) or
  2239. is_pwidechar(ld) or is_widechararray(ld) or is_widechar(ld) or is_open_widechararray(ld))) then
  2240. begin
  2241. if (nodetype in [addn,equaln,unequaln,lten,gten,ltn,gtn]) then
  2242. begin
  2243. { Is there a unicodestring? }
  2244. if is_unicodestring(rd) or is_unicodestring(ld) or
  2245. ((m_default_unicodestring in current_settings.modeswitches) and
  2246. (cs_refcountedstrings in current_settings.localswitches) and
  2247. (
  2248. is_pwidechar(rd) or is_widechararray(rd) or is_open_widechararray(rd) or (lt = stringconstn) or
  2249. is_pwidechar(ld) or is_widechararray(ld) or is_open_widechararray(ld) or (rt = stringconstn)
  2250. )
  2251. ) then
  2252. strtype:=st_unicodestring
  2253. else
  2254. { Is there a widestring? }
  2255. if is_widestring(rd) or is_widestring(ld) or
  2256. is_pwidechar(rd) or is_widechararray(rd) or is_widechar(rd) or is_open_widechararray(rd) or
  2257. is_pwidechar(ld) or is_widechararray(ld) or is_widechar(ld) or is_open_widechararray(ld) then
  2258. strtype:=st_widestring
  2259. else
  2260. if is_ansistring(rd) or is_ansistring(ld) or
  2261. ((cs_refcountedstrings in current_settings.localswitches) and
  2262. //todo: Move some of this to longstring's then they are implemented?
  2263. (
  2264. is_pchar(rd) or (is_chararray(rd) and (rd.size > 255)) or is_open_chararray(rd) or (lt = stringconstn) or
  2265. is_pchar(ld) or (is_chararray(ld) and (ld.size > 255)) or is_open_chararray(ld) or (rt = stringconstn)
  2266. )
  2267. ) then
  2268. strtype:=st_ansistring
  2269. else
  2270. if is_longstring(rd) or is_longstring(ld) then
  2271. strtype:=st_longstring
  2272. else
  2273. begin
  2274. { TODO: todo: add a warning/hint here if one converting a too large array}
  2275. { nodes is PChar, array [with size > 255] or OpenArrayOfChar.
  2276. Note: Delphi halts with error if "array [0..xx] of char"
  2277. is assigned to ShortString and string length is less
  2278. then array size }
  2279. strtype:= st_shortstring;
  2280. end;
  2281. // Now convert nodes to common string type
  2282. case strtype of
  2283. st_widestring :
  2284. begin
  2285. if not(is_widestring(rd)) then
  2286. inserttypeconv(right,cwidestringtype);
  2287. if not(is_widestring(ld)) then
  2288. inserttypeconv(left,cwidestringtype);
  2289. end;
  2290. st_unicodestring :
  2291. begin
  2292. if not(is_unicodestring(rd)) then
  2293. inserttypeconv(right,cunicodestringtype);
  2294. if not(is_unicodestring(ld)) then
  2295. inserttypeconv(left,cunicodestringtype);
  2296. end;
  2297. st_ansistring :
  2298. begin
  2299. { use same code page if possible (don't force same code
  2300. page in case both are ansistrings with code page <>
  2301. CP_NONE, since then data loss can occur: the ansistring
  2302. helpers will convert them at run time to an encoding
  2303. that can represent both encodings) }
  2304. if is_ansistring(ld) and
  2305. (tstringdef(ld).encoding<>0) and
  2306. (tstringdef(ld).encoding<>globals.CP_NONE) and
  2307. (not is_ansistring(rd) or
  2308. (tstringdef(rd).encoding=0) or
  2309. (tstringdef(rd).encoding=globals.CP_NONE)) then
  2310. inserttypeconv(right,ld)
  2311. else if is_ansistring(rd) and
  2312. (tstringdef(rd).encoding<>0) and
  2313. (tstringdef(rd).encoding<>globals.CP_NONE) and
  2314. (not is_ansistring(ld) or
  2315. (tstringdef(ld).encoding=0) or
  2316. (tstringdef(ld).encoding=globals.CP_NONE)) then
  2317. inserttypeconv(left,rd)
  2318. else
  2319. begin
  2320. if not is_ansistring(ld) then
  2321. inserttypeconv(left,getansistringdef);
  2322. if not is_ansistring(rd) then
  2323. inserttypeconv(right,getansistringdef);
  2324. end;
  2325. end;
  2326. st_longstring :
  2327. begin
  2328. if not(is_longstring(rd)) then
  2329. inserttypeconv(right,clongstringtype);
  2330. if not(is_longstring(ld)) then
  2331. inserttypeconv(left,clongstringtype);
  2332. end;
  2333. st_shortstring :
  2334. begin
  2335. if not(is_shortstring(ld)) then
  2336. inserttypeconv(left,cshortstringtype);
  2337. { don't convert char, that can be handled by the optimized node }
  2338. if not(is_shortstring(rd) or is_char(rd)) then
  2339. inserttypeconv(right,cshortstringtype);
  2340. end;
  2341. end;
  2342. end
  2343. else
  2344. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  2345. end
  2346. { implicit pointer object type comparison }
  2347. else if is_implicit_pointer_object_type(rd) or is_implicit_pointer_object_type(ld) then
  2348. begin
  2349. if (nodetype in [equaln,unequaln]) then
  2350. begin
  2351. if is_implicit_pointer_object_type(rd) and is_implicit_pointer_object_type(ld) then
  2352. begin
  2353. if def_is_related(tobjectdef(rd),tobjectdef(ld)) then
  2354. inserttypeconv(right,left.resultdef)
  2355. else
  2356. inserttypeconv(left,right.resultdef);
  2357. end
  2358. else if is_implicit_pointer_object_type(rd) then
  2359. inserttypeconv(left,right.resultdef)
  2360. else
  2361. inserttypeconv(right,left.resultdef);
  2362. end
  2363. else
  2364. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  2365. end
  2366. else if (rd.typ=classrefdef) and (ld.typ=classrefdef) then
  2367. begin
  2368. if (nodetype in [equaln,unequaln]) then
  2369. begin
  2370. if def_is_related(tobjectdef(tclassrefdef(rd).pointeddef),
  2371. tobjectdef(tclassrefdef(ld).pointeddef)) then
  2372. inserttypeconv(right,left.resultdef)
  2373. else
  2374. inserttypeconv(left,right.resultdef);
  2375. end
  2376. else
  2377. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  2378. end
  2379. { allow comparison with nil pointer }
  2380. else if is_implicit_pointer_object_type(rd) or (rd.typ=classrefdef) then
  2381. begin
  2382. if (nodetype in [equaln,unequaln]) then
  2383. inserttypeconv(left,right.resultdef)
  2384. else
  2385. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  2386. end
  2387. else if is_implicit_pointer_object_type(ld) or (ld.typ=classrefdef) then
  2388. begin
  2389. if (nodetype in [equaln,unequaln]) then
  2390. inserttypeconv(right,left.resultdef)
  2391. else
  2392. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  2393. end
  2394. { support procvar=nil,procvar<>nil }
  2395. else if ((ld.typ=procvardef) and (rt=niln)) or
  2396. ((rd.typ=procvardef) and (lt=niln)) then
  2397. begin
  2398. if not(nodetype in [equaln,unequaln]) then
  2399. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  2400. { find proc field in methodpointer record }
  2401. hsym:=tfieldvarsym(trecorddef(methodpointertype).symtable.Find('proc'));
  2402. if not assigned(hsym) then
  2403. internalerror(200412043);
  2404. { For methodpointers compare only tmethodpointer.proc }
  2405. if (rd.typ=procvardef) and
  2406. (not tprocvardef(rd).is_addressonly) then
  2407. begin
  2408. right:=csubscriptnode.create(
  2409. hsym,
  2410. ctypeconvnode.create_internal(right,methodpointertype));
  2411. typecheckpass(right);
  2412. end;
  2413. if (ld.typ=procvardef) and
  2414. (not tprocvardef(ld).is_addressonly) then
  2415. begin
  2416. left:=csubscriptnode.create(
  2417. hsym,
  2418. ctypeconvnode.create_internal(left,methodpointertype));
  2419. typecheckpass(left);
  2420. end;
  2421. if lt=niln then
  2422. inserttypeconv_explicit(left,right.resultdef)
  2423. else
  2424. inserttypeconv_explicit(right,left.resultdef)
  2425. end
  2426. { <dyn. array>+<dyn. array> ? }
  2427. else if (nodetype=addn) and (is_dynamic_array(ld) or is_dynamic_array(rd)) then
  2428. begin
  2429. result:=maybe_convert_to_insert;
  2430. if assigned(result) then
  2431. exit;
  2432. if not(is_dynamic_array(ld)) then
  2433. inserttypeconv(left,rd);
  2434. if not(is_dynamic_array(rd)) then
  2435. inserttypeconv(right,ld);
  2436. end
  2437. { support dynamicarray=nil,dynamicarray<>nil }
  2438. else if (is_dynamic_array(ld) and (rt=niln)) or
  2439. (is_dynamic_array(rd) and (lt=niln)) or
  2440. (is_dynamic_array(ld) and is_dynamic_array(rd)) then
  2441. begin
  2442. if not(nodetype in [equaln,unequaln]) then
  2443. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  2444. if lt=niln then
  2445. inserttypeconv_explicit(left,right.resultdef)
  2446. else
  2447. inserttypeconv_explicit(right,left.resultdef)
  2448. end
  2449. {$ifdef SUPPORT_MMX}
  2450. { mmx support, this must be before the zero based array
  2451. check }
  2452. else if (cs_mmx in current_settings.localswitches) and
  2453. is_mmx_able_array(ld) and
  2454. is_mmx_able_array(rd) and
  2455. equal_defs(ld,rd) then
  2456. begin
  2457. case nodetype of
  2458. addn,subn,xorn,orn,andn:
  2459. ;
  2460. { mul is a little bit restricted }
  2461. muln:
  2462. if not(mmx_type(ld) in [mmxu16bit,mmxs16bit,mmxfixed16]) then
  2463. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  2464. else
  2465. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  2466. end;
  2467. end
  2468. {$endif SUPPORT_MMX}
  2469. { vector support, this must be before the zero based array
  2470. check }
  2471. else if (cs_support_vectors in current_settings.globalswitches) and
  2472. is_vector(ld) and
  2473. is_vector(rd) and
  2474. equal_defs(ld,rd) then
  2475. begin
  2476. if not(nodetype in [addn,subn,xorn,orn,andn,muln,slashn]) then
  2477. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  2478. { both defs must be equal, so taking left or right as resultdef doesn't matter }
  2479. resultdef:=left.resultdef;
  2480. end
  2481. { this is a little bit dangerous, also the left type }
  2482. { pointer to should be checked! This broke the mmx support }
  2483. else if (rd.typ=pointerdef) or
  2484. (is_zero_based_array(rd) and (rt<>stringconstn)) then
  2485. begin
  2486. if is_zero_based_array(rd) then
  2487. begin
  2488. resultdef:=cpointerdef.getreusable(tarraydef(rd).elementdef);
  2489. inserttypeconv(right,resultdef);
  2490. end
  2491. else
  2492. resultdef:=right.resultdef;
  2493. inserttypeconv(left,tpointerdef(right.resultdef).pointer_arithmetic_int_type);
  2494. if nodetype=addn then
  2495. begin
  2496. if (rt=niln) then
  2497. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,'NIL');
  2498. if (not(cs_extsyntax in current_settings.moduleswitches) and not(nf_internal in flags)) or
  2499. (not (is_pchar(ld) or is_chararray(ld) or is_open_chararray(ld) or is_widechar(ld) or is_widechararray(ld) or is_open_widechararray(ld)) and
  2500. not(cs_pointermath in current_settings.localswitches) and
  2501. not((ld.typ=pointerdef) and tpointerdef(ld).has_pointer_math)) then
  2502. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  2503. if (rd.typ=pointerdef) and
  2504. (tpointerdef(rd).pointeddef.size>1) then
  2505. begin
  2506. left:=caddnode.create(muln,left,
  2507. cordconstnode.create(tpointerdef(rd).pointeddef.size,tpointerdef(right.resultdef).pointer_arithmetic_int_type,true));
  2508. typecheckpass(left);
  2509. end;
  2510. end
  2511. else
  2512. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  2513. end
  2514. else if (ld.typ=pointerdef) or
  2515. (is_zero_based_array(ld) and (lt<>stringconstn)) then
  2516. begin
  2517. if is_zero_based_array(ld) then
  2518. begin
  2519. resultdef:=cpointerdef.getreusable(tarraydef(ld).elementdef);
  2520. inserttypeconv(left,resultdef);
  2521. end
  2522. else
  2523. resultdef:=left.resultdef;
  2524. inserttypeconv(right,tpointerdef(left.resultdef).pointer_arithmetic_int_type);
  2525. if nodetype in [addn,subn] then
  2526. begin
  2527. if (lt=niln) then
  2528. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),'NIL',rd.typename);
  2529. if (not(cs_extsyntax in current_settings.moduleswitches) and not(nf_internal in flags)) or
  2530. (not (is_pchar(ld) or is_chararray(ld) or is_open_chararray(ld) or is_widechar(ld) or is_widechararray(ld) or is_open_widechararray(ld)) and
  2531. not(cs_pointermath in current_settings.localswitches) and
  2532. not((ld.typ=pointerdef) and tpointerdef(ld).has_pointer_math)) then
  2533. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  2534. if (ld.typ=pointerdef) then
  2535. begin
  2536. if is_big_untyped_addrnode(left) then
  2537. CGMessage1(type_w_untyped_arithmetic_unportable,node2opstr(nodetype));
  2538. if (tpointerdef(ld).pointeddef.size>1) then
  2539. begin
  2540. right:=caddnode.create(muln,right,
  2541. cordconstnode.create(tpointerdef(ld).pointeddef.size,tpointerdef(left.resultdef).pointer_arithmetic_int_type,true));
  2542. typecheckpass(right);
  2543. end
  2544. end else
  2545. if is_zero_based_array(ld) and
  2546. (tarraydef(ld).elementdef.size>1) then
  2547. begin
  2548. right:=caddnode.create(muln,right,
  2549. cordconstnode.create(tarraydef(ld).elementdef.size,tpointerdef(left.resultdef).pointer_arithmetic_int_type,true));
  2550. typecheckpass(right);
  2551. end;
  2552. end
  2553. else
  2554. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  2555. end
  2556. else if (rd.typ=procvardef) and
  2557. (ld.typ=procvardef) and
  2558. equal_defs(rd,ld) then
  2559. begin
  2560. if (nodetype in [equaln,unequaln]) then
  2561. begin
  2562. if tprocvardef(rd).is_addressonly then
  2563. begin
  2564. inserttypeconv_internal(right,voidcodepointertype);
  2565. inserttypeconv_internal(left,voidcodepointertype);
  2566. end
  2567. else
  2568. begin
  2569. { find proc field in methodpointer record }
  2570. hsym:=tfieldvarsym(trecorddef(methodpointertype).symtable.Find('proc'));
  2571. if not assigned(hsym) then
  2572. internalerror(200412043);
  2573. { Compare tmehodpointer(left).proc }
  2574. right:=csubscriptnode.create(
  2575. hsym,
  2576. ctypeconvnode.create_internal(right,methodpointertype));
  2577. typecheckpass(right);
  2578. left:=csubscriptnode.create(
  2579. hsym,
  2580. ctypeconvnode.create_internal(left,methodpointertype));
  2581. typecheckpass(left);
  2582. end;
  2583. end
  2584. else
  2585. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  2586. end
  2587. { enums }
  2588. else if (ld.typ=enumdef) and (rd.typ=enumdef) then
  2589. begin
  2590. if allowenumop(nodetype) or (nf_internal in flags) then
  2591. inserttypeconv(right,left.resultdef)
  2592. else
  2593. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
  2594. end
  2595. { generic conversion, this is for error recovery }
  2596. else
  2597. begin
  2598. inserttypeconv(left,sinttype);
  2599. inserttypeconv(right,sinttype);
  2600. end;
  2601. if cmp_of_disjunct_ranges(res) and not(nf_internal in flags) then
  2602. begin
  2603. if res then
  2604. CGMessage(type_w_comparison_always_true)
  2605. else
  2606. CGMessage(type_w_comparison_always_false);
  2607. end;
  2608. { set resultdef if not already done }
  2609. if not assigned(resultdef) then
  2610. begin
  2611. case nodetype of
  2612. ltn,lten,gtn,gten,equaln,unequaln :
  2613. resultdef:=pasbool1type;
  2614. slashn :
  2615. resultdef:=resultrealdef;
  2616. addn:
  2617. begin
  2618. { for strings, return is always a 255 char string }
  2619. if is_shortstring(left.resultdef) then
  2620. resultdef:=cshortstringtype
  2621. else
  2622. { for ansistrings set resultdef to assignment left node
  2623. if it is an assignment and left node expects ansistring }
  2624. if is_ansistring(left.resultdef) and
  2625. assigned(aktassignmentnode) and
  2626. (aktassignmentnode.right=self) and
  2627. is_ansistring(aktassignmentnode.left.resultdef) then
  2628. resultdef:=aktassignmentnode.left.resultdef
  2629. else
  2630. resultdef:=left.resultdef;
  2631. end;
  2632. else
  2633. resultdef:=left.resultdef;
  2634. end;
  2635. end;
  2636. { when the result is currency we need some extra code for
  2637. multiplication and division. this should not be done when
  2638. the muln or slashn node is created internally }
  2639. if not(nf_is_currency in flags) and
  2640. is_currency(resultdef) then
  2641. begin
  2642. case nodetype of
  2643. slashn :
  2644. begin
  2645. { slashn will only work with floats }
  2646. hp:=caddnode.create(muln,getcopy,crealconstnode.create(10000.0,s64currencytype));
  2647. include(hp.flags,nf_is_currency);
  2648. result:=hp;
  2649. end;
  2650. muln :
  2651. begin
  2652. hp:=nil;
  2653. if s64currencytype.typ=floatdef then
  2654. begin
  2655. { if left is a currency integer constant, we can get rid of the factor 10000 }
  2656. { int64(...) causes a cast on currency, so it is the currency value multiplied by 10000 }
  2657. if (left.nodetype=realconstn) and (is_currency(left.resultdef)) and (not(nf_is_currency in left.flags)) and ((trunc(trealconstnode(left).value_real) mod 10000)=0) then
  2658. begin
  2659. { trealconstnode expects that value_real and value_currency contain valid values }
  2660. {$ifdef FPC_CURRENCY_IS_INT64}
  2661. trealconstnode(left).value_currency:=pint64(@(trealconstnode(left).value_currency))^ div 10000;
  2662. {$else}
  2663. trealconstnode(left).value_currency:=trealconstnode(left).value_currency / 10000;
  2664. {$endif}
  2665. trealconstnode(left).value_real:=trealconstnode(left).value_real/10000;
  2666. end
  2667. { or if right is an integer constant, we can get rid of its factor 10000 }
  2668. else if (right.nodetype=realconstn) and (is_currency(right.resultdef)) and (not(nf_is_currency in right.flags)) and ((trunc(trealconstnode(right).value_real) mod 10000)=0) then
  2669. begin
  2670. { trealconstnode expects that value and value_currency contain valid values }
  2671. {$ifdef FPC_CURRENCY_IS_INT64}
  2672. trealconstnode(right).value_currency:=pint64(@(trealconstnode(right).value_currency))^ div 10000;
  2673. {$else}
  2674. trealconstnode(right).value_currency:=trealconstnode(right).value_currency / 10000;
  2675. {$endif}
  2676. trealconstnode(right).value_real:=trealconstnode(right).value_real/10000;
  2677. end
  2678. else
  2679. begin
  2680. hp:=caddnode.create(slashn,getcopy,crealconstnode.create(10000.0,s64currencytype));
  2681. include(hp.flags,nf_is_currency);
  2682. end;
  2683. end
  2684. else
  2685. begin
  2686. {$ifndef VER3_0}
  2687. { if left is a currency integer constant, we can get rid of the factor 10000 }
  2688. if (left.nodetype=ordconstn) and (is_currency(left.resultdef)) and ((tordconstnode(left).value mod 10000)=0) then
  2689. tordconstnode(left).value:=tordconstnode(left).value div 10000
  2690. { or if right is an integer constant, we can get rid of its factor 10000 }
  2691. else if (right.nodetype=ordconstn) and (is_currency(right.resultdef)) and ((tordconstnode(right).value mod 10000)=0) then
  2692. tordconstnode(right).value:=tordconstnode(right).value div 10000
  2693. else
  2694. {$endif VER3_0}
  2695. if (right.nodetype=muln) and is_currency(right.resultdef) and
  2696. { do not test swapped here as the internal conversions are only create as "var."*"10000" }
  2697. is_currency(taddnode(right).right.resultdef) and (taddnode(right).right.nodetype=ordconstn) and (tordconstnode(taddnode(right).right).value=10000) and
  2698. is_currency(taddnode(right).left.resultdef) and (taddnode(right).left.nodetype=typeconvn) then
  2699. begin
  2700. hp:=taddnode(right).left.getcopy;
  2701. include(hp.flags,nf_is_currency);
  2702. right.free;
  2703. right:=hp;
  2704. hp:=nil;
  2705. end
  2706. else if (left.nodetype=muln) and is_currency(left.resultdef) and
  2707. { do not test swapped here as the internal conversions are only create as "var."*"10000" }
  2708. is_currency(taddnode(left).right.resultdef) and (taddnode(left).right.nodetype=ordconstn) and (tordconstnode(taddnode(left).right).value=10000) and
  2709. is_currency(taddnode(left).left.resultdef) and (taddnode(left).left.nodetype=typeconvn) then
  2710. begin
  2711. hp:=taddnode(left).left.getcopy;
  2712. include(hp.flags,nf_is_currency);
  2713. left.free;
  2714. left:=hp;
  2715. hp:=nil;
  2716. end
  2717. else
  2718. begin
  2719. hp:=cmoddivnode.create(divn,getcopy,cordconstnode.create(10000,s64currencytype,false));
  2720. include(hp.flags,nf_is_currency);
  2721. end
  2722. end;
  2723. result:=hp
  2724. end;
  2725. else
  2726. ;
  2727. end;
  2728. end;
  2729. if not codegenerror and
  2730. not assigned(result) then
  2731. result:=simplify(false);
  2732. end;
  2733. function taddnode.first_addstring: tnode;
  2734. const
  2735. swap_relation: array [ltn..unequaln] of Tnodetype=(gtn, gten, ltn, lten, equaln, unequaln);
  2736. var
  2737. p: tnode;
  2738. newstatement : tstatementnode;
  2739. tempnode (*,tempnode2*) : ttempcreatenode;
  2740. cmpfuncname: string;
  2741. para: tcallparanode;
  2742. begin
  2743. result:=nil;
  2744. { when we get here, we are sure that both the left and the right }
  2745. { node are both strings of the same stringtype (JM) }
  2746. case nodetype of
  2747. addn:
  2748. begin
  2749. if (left.nodetype=stringconstn) and (tstringconstnode(left).len=0) then
  2750. begin
  2751. result:=right;
  2752. left.free;
  2753. left:=nil;
  2754. right:=nil;
  2755. exit;
  2756. end;
  2757. if (right.nodetype=stringconstn) and (tstringconstnode(right).len=0) then
  2758. begin
  2759. result:=left;
  2760. left:=nil;
  2761. right.free;
  2762. right:=nil;
  2763. exit;
  2764. end;
  2765. { create the call to the concat routine both strings as arguments }
  2766. if assigned(aktassignmentnode) and
  2767. (aktassignmentnode.right=self) and
  2768. (aktassignmentnode.left.resultdef=resultdef) and
  2769. valid_for_var(aktassignmentnode.left,false) then
  2770. begin
  2771. para:=ccallparanode.create(
  2772. right,
  2773. ccallparanode.create(
  2774. left,
  2775. ccallparanode.create(aktassignmentnode.left.getcopy,nil)
  2776. )
  2777. );
  2778. if is_ansistring(resultdef) then
  2779. para:=ccallparanode.create(
  2780. cordconstnode.create(
  2781. { don't use getparaencoding(), we have to know
  2782. when the result is rawbytestring }
  2783. tstringdef(resultdef).encoding,
  2784. u16inttype,
  2785. true
  2786. ),
  2787. para
  2788. );
  2789. result:=ccallnode.createintern(
  2790. 'fpc_'+tstringdef(resultdef).stringtypname+'_concat',
  2791. para
  2792. );
  2793. include(aktassignmentnode.flags,nf_assign_done_in_right);
  2794. firstpass(result);
  2795. end
  2796. else
  2797. begin
  2798. result:=internalstatements(newstatement);
  2799. tempnode:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true);
  2800. addstatement(newstatement,tempnode);
  2801. { initialize the temp, since it will be passed to a
  2802. var-parameter (and finalization, which is performed by the
  2803. ttempcreate node and which takes care of the initialization
  2804. on native targets, is a noop on managed VM targets) }
  2805. if (target_info.system in systems_managed_vm) and
  2806. is_managed_type(resultdef) then
  2807. addstatement(newstatement,cinlinenode.create(in_setlength_x,
  2808. false,
  2809. ccallparanode.create(genintconstnode(0),
  2810. ccallparanode.create(ctemprefnode.create(tempnode),nil))));
  2811. para:=ccallparanode.create(
  2812. right,
  2813. ccallparanode.create(
  2814. left,
  2815. ccallparanode.create(ctemprefnode.create(tempnode),nil)
  2816. )
  2817. );
  2818. if is_ansistring(resultdef) then
  2819. para:=ccallparanode.create(
  2820. cordconstnode.create(
  2821. { don't use getparaencoding(), we have to know
  2822. when the result is rawbytestring }
  2823. tstringdef(resultdef).encoding,
  2824. u16inttype,
  2825. true
  2826. ),
  2827. para
  2828. );
  2829. addstatement(
  2830. newstatement,
  2831. ccallnode.createintern(
  2832. 'fpc_'+tstringdef(resultdef).stringtypname+'_concat',
  2833. para
  2834. )
  2835. );
  2836. addstatement(newstatement,ctempdeletenode.create_normal_temp(tempnode));
  2837. addstatement(newstatement,ctemprefnode.create(tempnode));
  2838. end;
  2839. { we reused the arguments }
  2840. left := nil;
  2841. right := nil;
  2842. end;
  2843. ltn,lten,gtn,gten,equaln,unequaln :
  2844. begin
  2845. { generate better code for comparison with empty string, we
  2846. only need to compare the length with 0 }
  2847. if (nodetype in [equaln,unequaln,gtn,gten,ltn,lten]) and
  2848. { windows widestrings are too complicated to be handled optimized }
  2849. not(is_widestring(left.resultdef) and (target_info.system in systems_windows)) and
  2850. (((left.nodetype=stringconstn) and (tstringconstnode(left).len=0)) or
  2851. ((right.nodetype=stringconstn) and (tstringconstnode(right).len=0))) then
  2852. begin
  2853. { switch so that the constant is always on the right }
  2854. if left.nodetype = stringconstn then
  2855. begin
  2856. p := left;
  2857. left := right;
  2858. right := p;
  2859. nodetype:=swap_relation[nodetype];
  2860. end;
  2861. if is_shortstring(left.resultdef) or
  2862. (nodetype in [gtn,gten,ltn,lten]) or
  2863. (target_info.system in systems_managed_vm) then
  2864. { compare the length with 0 }
  2865. result := caddnode.create(nodetype,
  2866. cinlinenode.create(in_length_x,false,left),
  2867. cordconstnode.create(0,s8inttype,false))
  2868. else
  2869. begin
  2870. (*
  2871. if is_widestring(left.resultdef) and
  2872. (target_info.system in system_windows) then
  2873. begin
  2874. { windows like widestrings requires that we also check the length }
  2875. result:=internalstatements(newstatement);
  2876. tempnode:=ctempcreatenode.create(voidpointertype,voidpointertype.size,tt_persistent,true);
  2877. tempnode2:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true);
  2878. addstatement(newstatement,tempnode);
  2879. addstatement(newstatement,tempnode2);
  2880. { poor man's cse }
  2881. addstatement(newstatement,cassignmentnode.create(ctemprefnode.create(tempnode),
  2882. ctypeconvnode.create_internal(left,voidpointertype))
  2883. );
  2884. addstatement(newstatement,cassignmentnode.create(ctemprefnode.create(tempnode2),
  2885. caddnode.create(orn,
  2886. caddnode.create(nodetype,
  2887. ctemprefnode.create(tempnode),
  2888. cpointerconstnode.create(0,voidpointertype)
  2889. ),
  2890. caddnode.create(nodetype,
  2891. ctypeconvnode.create_internal(cderefnode.create(ctemprefnode.create(tempnode)),s32inttype),
  2892. cordconstnode.create(0,s32inttype,false)
  2893. )
  2894. )
  2895. ));
  2896. addstatement(newstatement,ctempdeletenode.create_normal_temp(tempnode));
  2897. addstatement(newstatement,ctempdeletenode.create_normal_temp(tempnode2));
  2898. addstatement(newstatement,ctemprefnode.create(tempnode2));
  2899. end
  2900. else
  2901. *)
  2902. begin
  2903. { compare the pointer with nil (for ansistrings etc), }
  2904. { faster than getting the length (JM) }
  2905. result:= caddnode.create(nodetype,
  2906. ctypeconvnode.create_internal(left,voidpointertype),
  2907. cpointerconstnode.create(0,voidpointertype));
  2908. end;
  2909. end;
  2910. { left is reused }
  2911. left := nil;
  2912. { right isn't }
  2913. right.free;
  2914. right := nil;
  2915. exit;
  2916. end;
  2917. { no string constant -> call compare routine }
  2918. cmpfuncname := 'fpc_'+tstringdef(left.resultdef).stringtypname+'_compare';
  2919. { for equality checks use optimized version }
  2920. if nodetype in [equaln,unequaln] then
  2921. cmpfuncname := cmpfuncname + '_equal';
  2922. result := ccallnode.createintern(cmpfuncname,
  2923. ccallparanode.create(right,ccallparanode.create(left,nil)));
  2924. { and compare its result with 0 according to the original operator }
  2925. result := caddnode.create(nodetype,result,
  2926. cordconstnode.create(0,s8inttype,false));
  2927. left := nil;
  2928. right := nil;
  2929. end;
  2930. else
  2931. internalerror(2019050520);
  2932. end;
  2933. end;
  2934. function taddnode.first_addset : tnode;
  2935. procedure call_varset_helper(const n : string);
  2936. var
  2937. newstatement : tstatementnode;
  2938. temp : ttempcreatenode;
  2939. begin
  2940. { add two var sets }
  2941. result:=internalstatements(newstatement);
  2942. { create temp for result }
  2943. temp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true);
  2944. addstatement(newstatement,temp);
  2945. addstatement(newstatement,ccallnode.createintern(n,
  2946. ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false),
  2947. ccallparanode.create(ctemprefnode.create(temp),
  2948. ccallparanode.create(right,
  2949. ccallparanode.create(left,nil)))))
  2950. );
  2951. { remove reused parts from original node }
  2952. left:=nil;
  2953. right:=nil;
  2954. { the last statement should return the value as
  2955. location and type, this is done be referencing the
  2956. temp and converting it first from a persistent temp to
  2957. normal temp }
  2958. addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
  2959. addstatement(newstatement,ctemprefnode.create(temp));
  2960. end;
  2961. var
  2962. procname: string[31];
  2963. tempn: tnode;
  2964. newstatement : tstatementnode;
  2965. temp : ttempcreatenode;
  2966. begin
  2967. result:=nil;
  2968. case nodetype of
  2969. equaln,unequaln,lten,gten:
  2970. begin
  2971. case nodetype of
  2972. equaln,unequaln:
  2973. procname := 'fpc_varset_comp_sets';
  2974. lten,gten:
  2975. begin
  2976. procname := 'fpc_varset_contains_sets';
  2977. { (left >= right) = (right <= left) }
  2978. if nodetype = gten then
  2979. begin
  2980. tempn := left;
  2981. left := right;
  2982. right := tempn;
  2983. end;
  2984. end;
  2985. else
  2986. internalerror(2013112911);
  2987. end;
  2988. result := ccallnode.createinternres(procname,
  2989. ccallparanode.create(cordconstnode.create(left.resultdef.size,sinttype,false),
  2990. ccallparanode.create(right,
  2991. ccallparanode.create(left,nil))),resultdef);
  2992. { left and right are reused as parameters }
  2993. left := nil;
  2994. right := nil;
  2995. { for an unequaln, we have to negate the result of comp_sets }
  2996. if nodetype = unequaln then
  2997. result := cnotnode.create(result);
  2998. end;
  2999. addn:
  3000. begin
  3001. { optimize first loading of a set }
  3002. if (right.nodetype=setelementn) and
  3003. not(assigned(tsetelementnode(right).right)) and
  3004. is_emptyset(left) then
  3005. begin
  3006. result:=internalstatements(newstatement);
  3007. { create temp for result }
  3008. temp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true);
  3009. addstatement(newstatement,temp);
  3010. { adjust for set base }
  3011. tsetelementnode(right).left:=caddnode.create(subn,
  3012. ctypeconvnode.create_internal(tsetelementnode(right).left,sinttype),
  3013. cordconstnode.create(tsetdef(resultdef).setbase,sinttype,false));
  3014. addstatement(newstatement,ccallnode.createintern('fpc_varset_create_element',
  3015. ccallparanode.create(ctemprefnode.create(temp),
  3016. ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false),
  3017. ccallparanode.create(tsetelementnode(right).left,nil))))
  3018. );
  3019. { the last statement should return the value as
  3020. location and type, this is done be referencing the
  3021. temp and converting it first from a persistent temp to
  3022. normal temp }
  3023. addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
  3024. addstatement(newstatement,ctemprefnode.create(temp));
  3025. tsetelementnode(right).left := nil;
  3026. end
  3027. else
  3028. begin
  3029. if right.nodetype=setelementn then
  3030. begin
  3031. result:=internalstatements(newstatement);
  3032. { create temp for result }
  3033. temp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true);
  3034. addstatement(newstatement,temp);
  3035. { adjust for set base }
  3036. tsetelementnode(right).left:=caddnode.create(subn,
  3037. ctypeconvnode.create_internal(tsetelementnode(right).left,sinttype),
  3038. cordconstnode.create(tsetdef(resultdef).setbase,sinttype,false));
  3039. { add a range or a single element? }
  3040. if assigned(tsetelementnode(right).right) then
  3041. begin
  3042. { adjust for set base }
  3043. tsetelementnode(right).right:=caddnode.create(subn,
  3044. ctypeconvnode.create_internal(tsetelementnode(right).right,sinttype),
  3045. cordconstnode.create(tsetdef(resultdef).setbase,sinttype,false));
  3046. addstatement(newstatement,ccallnode.createintern('fpc_varset_set_range',
  3047. ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false),
  3048. ccallparanode.create(tsetelementnode(right).right,
  3049. ccallparanode.create(tsetelementnode(right).left,
  3050. ccallparanode.create(ctemprefnode.create(temp),
  3051. ccallparanode.create(left,nil))))))
  3052. );
  3053. end
  3054. else
  3055. addstatement(newstatement,ccallnode.createintern('fpc_varset_set',
  3056. ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false),
  3057. ccallparanode.create(ctypeconvnode.create_internal(tsetelementnode(right).left,sinttype),
  3058. ccallparanode.create(ctemprefnode.create(temp),
  3059. ccallparanode.create(left,nil)))))
  3060. );
  3061. { remove reused parts from original node }
  3062. tsetelementnode(right).right:=nil;
  3063. tsetelementnode(right).left:=nil;
  3064. left:=nil;
  3065. { the last statement should return the value as
  3066. location and type, this is done be referencing the
  3067. temp and converting it first from a persistent temp to
  3068. normal temp }
  3069. addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
  3070. addstatement(newstatement,ctemprefnode.create(temp));
  3071. end
  3072. else
  3073. call_varset_helper('fpc_varset_add_sets');
  3074. end
  3075. end;
  3076. subn:
  3077. call_varset_helper('fpc_varset_sub_sets');
  3078. symdifn:
  3079. call_varset_helper('fpc_varset_symdif_sets');
  3080. muln:
  3081. call_varset_helper('fpc_varset_mul_sets');
  3082. else
  3083. internalerror(200609241);
  3084. end;
  3085. end;
  3086. function taddnode.first_adddynarray : tnode;
  3087. var
  3088. newstatement : tstatementnode;
  3089. tempnode (*,tempnode2*) : ttempcreatenode;
  3090. para: tcallparanode;
  3091. begin
  3092. result:=nil;
  3093. { when we get here, we are sure that both the left and the right }
  3094. { node are both strings of the same stringtype (JM) }
  3095. case nodetype of
  3096. addn:
  3097. begin
  3098. if (left.nodetype=arrayconstructorn) and (tarrayconstructornode(left).isempty) then
  3099. begin
  3100. result:=right;
  3101. left.free;
  3102. left:=nil;
  3103. right:=nil;
  3104. exit;
  3105. end;
  3106. if (right.nodetype=arrayconstructorn) and (tarrayconstructornode(right).isempty) then
  3107. begin
  3108. result:=left;
  3109. left:=nil;
  3110. right.free;
  3111. right:=nil;
  3112. exit;
  3113. end;
  3114. { create the call to the concat routine both strings as arguments }
  3115. if assigned(aktassignmentnode) and
  3116. (aktassignmentnode.right=self) and
  3117. (aktassignmentnode.left.resultdef=resultdef) and
  3118. valid_for_var(aktassignmentnode.left,false) then
  3119. begin
  3120. para:=ccallparanode.create(
  3121. ctypeconvnode.create_internal(right,voidcodepointertype),
  3122. ccallparanode.create(
  3123. ctypeconvnode.create_internal(left,voidcodepointertype),
  3124. ccallparanode.create(
  3125. caddrnode.create_internal(crttinode.create(tstoreddef(resultdef),initrtti,rdt_normal)),
  3126. ccallparanode.create(
  3127. ctypeconvnode.create_internal(aktassignmentnode.left.getcopy,voidcodepointertype),nil)
  3128. )));
  3129. result:=ccallnode.createintern(
  3130. 'fpc_dynarray_concat',
  3131. para
  3132. );
  3133. include(aktassignmentnode.flags,nf_assign_done_in_right);
  3134. firstpass(result);
  3135. end
  3136. else
  3137. begin
  3138. result:=internalstatements(newstatement);
  3139. tempnode:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true);
  3140. addstatement(newstatement,tempnode);
  3141. { initialize the temp, since it will be passed to a
  3142. var-parameter (and finalization, which is performed by the
  3143. ttempcreate node and which takes care of the initialization
  3144. on native targets, is a noop on managed VM targets) }
  3145. if (target_info.system in systems_managed_vm) and
  3146. is_managed_type(resultdef) then
  3147. addstatement(newstatement,cinlinenode.create(in_setlength_x,
  3148. false,
  3149. ccallparanode.create(genintconstnode(0),
  3150. ccallparanode.create(ctemprefnode.create(tempnode),nil))));
  3151. para:=ccallparanode.create(
  3152. ctypeconvnode.create_internal(right,voidcodepointertype),
  3153. ccallparanode.create(
  3154. ctypeconvnode.create_internal(left,voidcodepointertype),
  3155. ccallparanode.create(
  3156. caddrnode.create_internal(crttinode.create(tstoreddef(resultdef),initrtti,rdt_normal)),
  3157. ccallparanode.create(
  3158. ctypeconvnode.create_internal(ctemprefnode.create(tempnode),voidcodepointertype),nil)
  3159. )));
  3160. addstatement(
  3161. newstatement,
  3162. ccallnode.createintern(
  3163. 'fpc_dynarray_concat',
  3164. para
  3165. )
  3166. );
  3167. addstatement(newstatement,ctempdeletenode.create_normal_temp(tempnode));
  3168. addstatement(newstatement,ctemprefnode.create(tempnode));
  3169. end;
  3170. { we reused the arguments }
  3171. left := nil;
  3172. right := nil;
  3173. end;
  3174. unequaln,equaln:
  3175. { nothing to do }
  3176. ;
  3177. else
  3178. Internalerror(2018030301);
  3179. end;
  3180. end;
  3181. function taddnode.use_generic_mul32to64: boolean;
  3182. begin
  3183. result := true;
  3184. end;
  3185. function taddnode.use_generic_mul64bit: boolean;
  3186. begin
  3187. result := true;
  3188. end;
  3189. function taddnode.try_make_mul32to64: boolean;
  3190. function canbe32bitint(v: tconstexprint; out canbesignedconst, canbeunsignedconst: boolean): boolean;
  3191. begin
  3192. result := ((v >= int64(low(longint))) and (v <= int64(high(longint)))) or
  3193. ((v >= qword(low(cardinal))) and (v <= qword(high(cardinal))));
  3194. canbesignedconst:=v<=int64(high(longint));
  3195. canbeunsignedconst:=v>=0;
  3196. end;
  3197. function is_32bitordconst(n: tnode; out canbesignedconst, canbeunsignedconst: boolean): boolean;
  3198. begin
  3199. canbesignedconst:=false;
  3200. canbeunsignedconst:=false;
  3201. result := (n.nodetype = ordconstn) and
  3202. canbe32bitint(tordconstnode(n).value, canbesignedconst, canbeunsignedconst);
  3203. end;
  3204. function is_32to64typeconv(n: tnode): boolean;
  3205. begin
  3206. result := (n.nodetype = typeconvn) and
  3207. is_integer(ttypeconvnode(n).left.resultdef) and
  3208. not is_64bit(ttypeconvnode(n).left.resultdef);
  3209. end;
  3210. var
  3211. temp: tnode;
  3212. leftoriginallysigned,
  3213. canbesignedconst, canbeunsignedconst: boolean;
  3214. begin
  3215. result := false;
  3216. if is_32to64typeconv(left) then
  3217. begin
  3218. leftoriginallysigned:=is_signed(ttypeconvnode(left).left.resultdef);
  3219. if ((is_32bitordconst(right,canbesignedconst, canbeunsignedconst) and
  3220. ((leftoriginallysigned and canbesignedconst) or
  3221. (not leftoriginallysigned and canbeunsignedconst))) or
  3222. (is_32to64typeconv(right) and
  3223. ((leftoriginallysigned =
  3224. is_signed(ttypeconvnode(right).left.resultdef)) or
  3225. (leftoriginallysigned and
  3226. (torddef(ttypeconvnode(right).left.resultdef).ordtype in [u8bit,u16bit]))))) then
  3227. begin
  3228. temp := ttypeconvnode(left).left;
  3229. ttypeconvnode(left).left := nil;
  3230. left.free;
  3231. left := temp;
  3232. if (right.nodetype = typeconvn) then
  3233. begin
  3234. temp := ttypeconvnode(right).left;
  3235. ttypeconvnode(right).left := nil;
  3236. right.free;
  3237. right := temp;
  3238. end;
  3239. if (is_signed(left.resultdef)) then
  3240. begin
  3241. inserttypeconv_internal(left,s32inttype);
  3242. inserttypeconv_internal(right,s32inttype);
  3243. end
  3244. else
  3245. begin
  3246. inserttypeconv_internal(left,u32inttype);
  3247. inserttypeconv_internal(right,u32inttype);
  3248. end;
  3249. firstpass(left);
  3250. firstpass(right);
  3251. result := true;
  3252. end;
  3253. end;
  3254. end;
  3255. function taddnode.use_fma : boolean;
  3256. begin
  3257. result:=false;
  3258. end;
  3259. function taddnode.try_fma(ld,rd : tdef) : tnode;
  3260. var
  3261. inlinennr : tinlinenumber;
  3262. begin
  3263. result:=nil;
  3264. if (cs_opt_fastmath in current_settings.optimizerswitches) and
  3265. use_fma and
  3266. (nodetype in [addn,subn]) and
  3267. (rd.typ=floatdef) and (ld.typ=floatdef) and
  3268. (is_single(rd) or is_double(rd)) and
  3269. equal_defs(rd,ld) and
  3270. { transforming a*b+c into fma(a,b,c) makes only sense if c can be
  3271. calculated easily. Consider a*b+c*d which results in
  3272. fmul
  3273. fmul
  3274. fadd
  3275. and in
  3276. fmul
  3277. fma
  3278. when using the fma optimization. On a super scalar architecture, the first instruction
  3279. sequence requires clock_cycles(fmul)+clock_cycles(fadd) clock cycles because the fmuls can be executed in parallel.
  3280. The second sequence requires clock_cycles(fmul)+clock_cycles(fma) because the fma has to wait for the
  3281. result of the fmul. Since typically clock_cycles(fma)>clock_cycles(fadd) applies, the first sequence is better.
  3282. }
  3283. (((left.nodetype=muln) and (node_complexity(right)<3)) or
  3284. ((right.nodetype=muln) and (node_complexity(left)<3)) or
  3285. ((left.nodetype=inlinen) and
  3286. (tinlinenode(left).inlinenumber=in_sqr_real) and
  3287. (node_complexity(right)<3)) or
  3288. ((right.nodetype=inlinen) and
  3289. (tinlinenode(right).inlinenumber=in_sqr_real) and
  3290. (node_complexity(left)<3))
  3291. ) then
  3292. begin
  3293. case tfloatdef(ld).floattype of
  3294. s32real:
  3295. inlinennr:=in_fma_single;
  3296. s64real:
  3297. inlinennr:=in_fma_double;
  3298. s80real:
  3299. inlinennr:=in_fma_extended;
  3300. s128real:
  3301. inlinennr:=in_fma_float128;
  3302. else
  3303. internalerror(2014042601);
  3304. end;
  3305. if left.nodetype=muln then
  3306. begin
  3307. if nodetype=subn then
  3308. result:=cinlinenode.create(inlinennr,false,ccallparanode.create(cunaryminusnode.create(right),
  3309. ccallparanode.create(taddnode(left).right,
  3310. ccallparanode.create(taddnode(left).left,nil
  3311. ))))
  3312. else
  3313. result:=cinlinenode.create(inlinennr,false,ccallparanode.create(right,
  3314. ccallparanode.create(taddnode(left).right,
  3315. ccallparanode.create(taddnode(left).left,nil
  3316. ))));
  3317. right:=nil;
  3318. taddnode(left).right:=nil;
  3319. taddnode(left).left:=nil;
  3320. end
  3321. else if right.nodetype=muln then
  3322. begin
  3323. if nodetype=subn then
  3324. result:=cinlinenode.create(inlinennr,false,ccallparanode.create(left,
  3325. ccallparanode.create(cunaryminusnode.create(taddnode(right).right),
  3326. ccallparanode.create(taddnode(right).left,nil
  3327. ))))
  3328. else
  3329. result:=cinlinenode.create(inlinennr,false,ccallparanode.create(left,
  3330. ccallparanode.create(taddnode(right).right,
  3331. ccallparanode.create(taddnode(right).left,nil
  3332. ))));
  3333. left:=nil;
  3334. taddnode(right).right:=nil;
  3335. taddnode(right).left:=nil;
  3336. end
  3337. else if (left.nodetype=inlinen) and (tinlinenode(left).inlinenumber=in_sqr_real) then
  3338. begin
  3339. if nodetype=subn then
  3340. result:=cinlinenode.create(inlinennr,false,ccallparanode.create(cunaryminusnode.create(right),
  3341. ccallparanode.create(tinlinenode(left).left.getcopy,
  3342. ccallparanode.create(tinlinenode(left).left.getcopy,nil
  3343. ))))
  3344. else
  3345. result:=cinlinenode.create(inlinennr,false,ccallparanode.create(right,
  3346. ccallparanode.create(tinlinenode(left).left.getcopy,
  3347. ccallparanode.create(tinlinenode(left).left.getcopy,nil
  3348. ))));
  3349. right:=nil;
  3350. end
  3351. { we get here only if right is a sqr node }
  3352. else if (right.nodetype=inlinen) and (tinlinenode(right).inlinenumber=in_sqr_real) then
  3353. begin
  3354. if nodetype=subn then
  3355. result:=cinlinenode.create(inlinennr,false,ccallparanode.create(left,
  3356. ccallparanode.create(cunaryminusnode.create(tinlinenode(right).left.getcopy),
  3357. ccallparanode.create(tinlinenode(right).left.getcopy,nil
  3358. ))))
  3359. else
  3360. result:=cinlinenode.create(inlinennr,false,ccallparanode.create(left,
  3361. ccallparanode.create(tinlinenode(right).left.getcopy,
  3362. ccallparanode.create(tinlinenode(right).left.getcopy,nil
  3363. ))));
  3364. left:=nil;
  3365. end;
  3366. end;
  3367. end;
  3368. function taddnode.first_add64bitint: tnode;
  3369. var
  3370. procname: string[31];
  3371. temp: tnode;
  3372. power: longint;
  3373. begin
  3374. result := nil;
  3375. { create helper calls mul }
  3376. if nodetype <> muln then
  3377. exit;
  3378. { make sure that if there is a constant, that it's on the right }
  3379. if left.nodetype = ordconstn then
  3380. begin
  3381. temp := right;
  3382. right := left;
  3383. left := temp;
  3384. end;
  3385. { can we use a shift instead of a mul? }
  3386. if not (cs_check_overflow in current_settings.localswitches) and
  3387. (right.nodetype = ordconstn) and
  3388. ispowerof2(tordconstnode(right).value,power) then
  3389. begin
  3390. tordconstnode(right).value := power;
  3391. result := cshlshrnode.create(shln,left,right);
  3392. { left and right are reused }
  3393. left := nil;
  3394. right := nil;
  3395. { return firstpassed new node }
  3396. exit;
  3397. end;
  3398. if try_make_mul32to64 then
  3399. begin
  3400. { this uses the same criteria for signedness as the 32 to 64-bit mul
  3401. handling in the i386 code generator }
  3402. if is_signed(left.resultdef) and is_signed(right.resultdef) then
  3403. procname := 'fpc_mul_longint_to_int64'
  3404. else
  3405. procname := 'fpc_mul_dword_to_qword';
  3406. right := ccallparanode.create(right,ccallparanode.create(left,nil));
  3407. result := ccallnode.createintern(procname,right);
  3408. left := nil;
  3409. right := nil;
  3410. end
  3411. else
  3412. begin
  3413. { can full 64-bit multiplication be handled inline? }
  3414. if not use_generic_mul64bit then
  3415. begin
  3416. { generic handling replaces this node with call to fpc_mul_int64,
  3417. whose result is int64 }
  3418. if is_currency(resultdef) then
  3419. resultdef:=s64inttype;
  3420. exit;
  3421. end;
  3422. { when currency is used set the result of the
  3423. parameters to s64bit, so they are not converted }
  3424. if is_currency(resultdef) then
  3425. begin
  3426. left.resultdef:=s64inttype;
  3427. right.resultdef:=s64inttype;
  3428. end;
  3429. { otherwise, create the parameters for the helper }
  3430. right := ccallparanode.create(right,ccallparanode.create(left,nil));
  3431. left := nil;
  3432. { only qword needs the unsigned code, the
  3433. signed code is also used for currency }
  3434. if is_signed(resultdef) then
  3435. procname := 'fpc_mul_int64'
  3436. else
  3437. procname := 'fpc_mul_qword';
  3438. if cs_check_overflow in current_settings.localswitches then
  3439. procname := procname + '_checkoverflow';
  3440. result := ccallnode.createintern(procname,right);
  3441. right := nil;
  3442. end;
  3443. end;
  3444. function taddnode.first_addpointer: tnode;
  3445. begin
  3446. result:=nil;
  3447. expectloc:=LOC_REGISTER;
  3448. end;
  3449. function taddnode.first_cmppointer: tnode;
  3450. begin
  3451. result:=nil;
  3452. expectloc:=LOC_FLAGS;
  3453. end;
  3454. function taddnode.first_addfloat_soft : tnode;
  3455. var
  3456. procname: string[31];
  3457. { do we need to reverse the result ? }
  3458. notnode : boolean;
  3459. fdef : tdef;
  3460. begin
  3461. notnode:=false;
  3462. result:=nil;
  3463. fdef:=nil;
  3464. if not(target_info.system in systems_wince) then
  3465. begin
  3466. case tfloatdef(left.resultdef).floattype of
  3467. s32real:
  3468. begin
  3469. fdef:=search_system_type('FLOAT32REC').typedef;
  3470. procname:='float32';
  3471. end;
  3472. s64real:
  3473. begin
  3474. fdef:=search_system_type('FLOAT64').typedef;
  3475. procname:='float64';
  3476. end;
  3477. {!!! not yet implemented
  3478. s128real:
  3479. }
  3480. else
  3481. internalerror(2005082601);
  3482. end;
  3483. case nodetype of
  3484. addn:
  3485. procname:=procname+'_add';
  3486. muln:
  3487. procname:=procname+'_mul';
  3488. subn:
  3489. procname:=procname+'_sub';
  3490. slashn:
  3491. procname:=procname+'_div';
  3492. ltn:
  3493. procname:=procname+'_lt';
  3494. lten:
  3495. procname:=procname+'_le';
  3496. gtn:
  3497. begin
  3498. procname:=procname+'_lt';
  3499. swapleftright;
  3500. end;
  3501. gten:
  3502. begin
  3503. procname:=procname+'_le';
  3504. swapleftright;
  3505. end;
  3506. equaln:
  3507. procname:=procname+'_eq';
  3508. unequaln:
  3509. begin
  3510. procname:=procname+'_eq';
  3511. notnode:=true;
  3512. end;
  3513. else
  3514. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),left.resultdef.typename,right.resultdef.typename);
  3515. end;
  3516. end
  3517. else
  3518. begin
  3519. case nodetype of
  3520. addn:
  3521. procname:='add';
  3522. muln:
  3523. procname:='mul';
  3524. subn:
  3525. procname:='sub';
  3526. slashn:
  3527. procname:='div';
  3528. ltn:
  3529. procname:='lt';
  3530. lten:
  3531. procname:='le';
  3532. gtn:
  3533. procname:='gt';
  3534. gten:
  3535. procname:='ge';
  3536. equaln:
  3537. procname:='eq';
  3538. unequaln:
  3539. procname:='ne';
  3540. else
  3541. begin
  3542. CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),left.resultdef.typename,right.resultdef.typename);
  3543. exit;
  3544. end;
  3545. end;
  3546. case tfloatdef(left.resultdef).floattype of
  3547. s32real:
  3548. begin
  3549. procname:=procname+'s';
  3550. if nodetype in [addn,muln,subn,slashn] then
  3551. procname:=lower(procname);
  3552. end;
  3553. s64real:
  3554. procname:=procname+'d';
  3555. {!!! not yet implemented
  3556. s128real:
  3557. }
  3558. else
  3559. internalerror(2005082602);
  3560. end;
  3561. end;
  3562. { cast softfpu result? }
  3563. if not(target_info.system in systems_wince) then
  3564. begin
  3565. if nodetype in [ltn,lten,gtn,gten,equaln,unequaln] then
  3566. resultdef:=pasbool1type;
  3567. result:=ctypeconvnode.create_internal(ccallnode.createintern(procname,ccallparanode.create(
  3568. ctypeconvnode.create_internal(right,fdef),
  3569. ccallparanode.create(
  3570. ctypeconvnode.create_internal(left,fdef),nil))),resultdef);
  3571. end
  3572. else
  3573. result:=ccallnode.createintern(procname,ccallparanode.create(right,
  3574. ccallparanode.create(left,nil)));
  3575. left:=nil;
  3576. right:=nil;
  3577. { do we need to reverse the result }
  3578. if notnode then
  3579. result:=cnotnode.create(result);
  3580. end;
  3581. function taddnode.first_addfloat : tnode;
  3582. begin
  3583. result := nil;
  3584. { In non-emulation mode, real opcodes are
  3585. emitted for floating point values.
  3586. }
  3587. if not ((cs_fp_emulation in current_settings.moduleswitches)
  3588. {$ifdef cpufpemu}
  3589. or (current_settings.fputype=fpu_soft)
  3590. {$endif cpufpemu}
  3591. ) then
  3592. exit;
  3593. result:=first_addfloat_soft
  3594. end;
  3595. {$ifdef cpuneedsmulhelper}
  3596. function taddnode.use_mul_helper: boolean;
  3597. begin
  3598. result:=(nodetype=muln) and
  3599. not(torddef(resultdef).ordtype in [u8bit,s8bit
  3600. {$if defined(cpu16bitalu) or defined(avr)},u16bit,s16bit{$endif}]);
  3601. end;
  3602. {$endif cpuneedsmulhelper}
  3603. function taddnode.pass_1 : tnode;
  3604. function isconstsetfewelements(p : tnode) : boolean;
  3605. begin
  3606. result:=(p.nodetype=setconstn) and (tsetconstnode(p).elements<=4);
  3607. end;
  3608. var
  3609. {$ifdef addstringopt}
  3610. hp : tnode;
  3611. {$endif addstringopt}
  3612. rd,ld : tdef;
  3613. i,i2 : longint;
  3614. lt,rt : tnodetype;
  3615. {$ifdef cpuneedsmulhelper}
  3616. procname : string[32];
  3617. {$endif cpuneedsmulhelper}
  3618. tempn,varsetnode: tnode;
  3619. mulnode : taddnode;
  3620. constsetnode : tsetconstnode;
  3621. trycreateinnodes : Boolean;
  3622. begin
  3623. result:=nil;
  3624. { Can we optimize multiple string additions into a single call?
  3625. This need to be done on a complete tree to detect the multiple
  3626. add nodes and is therefor done before the subtrees are processed }
  3627. if canbemultistringadd(self) then
  3628. begin
  3629. result:=genmultistringadd(self);
  3630. exit;
  3631. end;
  3632. { Can we optimize multiple dyn. array additions into a single call?
  3633. This need to be done on a complete tree to detect the multiple
  3634. add nodes and is therefor done before the subtrees are processed }
  3635. if (m_array_operators in current_settings.modeswitches) and canbemultidynarrayadd(self) then
  3636. begin
  3637. result:=genmultidynarrayadd(self);
  3638. exit;
  3639. end;
  3640. { typical set tests like (s*[const. set])<>/=[] can be converted into an or'ed chain of in tests
  3641. for var sets if const. set contains only a few elements }
  3642. if (cs_opt_level1 in current_settings.optimizerswitches) and (nodetype in [unequaln,equaln]) and (left.resultdef.typ=setdef) and not(is_smallset(left.resultdef)) then
  3643. begin
  3644. trycreateinnodes:=false;
  3645. mulnode:=nil;
  3646. if (is_emptyset(right) and (left.nodetype=muln) and
  3647. (isconstsetfewelements(taddnode(left).right) or isconstsetfewelements(taddnode(left).left))) then
  3648. begin
  3649. trycreateinnodes:=true;
  3650. mulnode:=taddnode(left);
  3651. end
  3652. else if (is_emptyset(left) and (right.nodetype=muln) and
  3653. (isconstsetfewelements(taddnode(right).right) or isconstsetfewelements(taddnode(right).left))) then
  3654. begin
  3655. trycreateinnodes:=true;
  3656. mulnode:=taddnode(right);
  3657. end;
  3658. if trycreateinnodes then
  3659. begin
  3660. constsetnode:=nil;
  3661. varsetnode:=nil;
  3662. if isconstsetfewelements(mulnode.right) then
  3663. begin
  3664. constsetnode:=tsetconstnode(mulnode.right);
  3665. varsetnode:=mulnode.left;
  3666. end
  3667. else
  3668. begin
  3669. constsetnode:=tsetconstnode(mulnode.left);
  3670. varsetnode:=mulnode.right;
  3671. end;
  3672. { the node is copied so it might have no side effects, if the complexity is too, cse should fix it, so
  3673. do not check complexity }
  3674. if not(might_have_sideeffects(varsetnode)) then
  3675. begin
  3676. result:=nil;
  3677. for i:=low(tconstset) to high(tconstset) do
  3678. if i in constsetnode.value_set^ then
  3679. begin
  3680. tempn:=cinnode.create(cordconstnode.create(i,tsetdef(constsetnode.resultdef).elementdef,false),varsetnode.getcopy);
  3681. if assigned(result) then
  3682. result:=caddnode.create_internal(orn,result,tempn)
  3683. else
  3684. result:=tempn;
  3685. end;
  3686. if nodetype=equaln then
  3687. result:=cnotnode.create(result);
  3688. exit;
  3689. end;
  3690. end;
  3691. end;
  3692. { first do the two subtrees }
  3693. firstpass(left);
  3694. firstpass(right);
  3695. if codegenerror then
  3696. exit;
  3697. { load easier access variables }
  3698. rd:=right.resultdef;
  3699. ld:=left.resultdef;
  3700. rt:=right.nodetype;
  3701. lt:=left.nodetype;
  3702. { int/int gives real/real! }
  3703. if nodetype=slashn then
  3704. begin
  3705. {$ifdef cpufpemu}
  3706. result:=first_addfloat;
  3707. if assigned(result) then
  3708. exit;
  3709. {$endif cpufpemu}
  3710. expectloc:=LOC_FPUREGISTER;
  3711. end
  3712. { if both are orddefs then check sub types }
  3713. else if (ld.typ=orddef) and (rd.typ=orddef) then
  3714. begin
  3715. { optimize multiplacation by a power of 2 }
  3716. if not(cs_check_overflow in current_settings.localswitches) and
  3717. (nodetype = muln) and
  3718. (((left.nodetype = ordconstn) and
  3719. ispowerof2(tordconstnode(left).value,i)) or
  3720. ((right.nodetype = ordconstn) and
  3721. ispowerof2(tordconstnode(right).value,i2))) then
  3722. begin
  3723. { it could be that we are converting a 32x32 -> 64 multiplication:
  3724. in this case, we have to restore the type conversion }
  3725. inserttypeconv_internal(left,resultdef);
  3726. inserttypeconv_internal(right,resultdef);
  3727. if ((left.nodetype = ordconstn) and
  3728. ispowerof2(tordconstnode(left).value,i)) then
  3729. begin
  3730. tordconstnode(left).value := i;
  3731. result := cshlshrnode.create(shln,right,left);
  3732. end
  3733. else
  3734. begin
  3735. tordconstnode(right).value := i2;
  3736. result := cshlshrnode.create(shln,left,right);
  3737. end;
  3738. result.resultdef := resultdef;
  3739. left := nil;
  3740. right := nil;
  3741. exit;
  3742. end;
  3743. { 2 booleans ? }
  3744. if is_boolean(ld) and is_boolean(rd) then
  3745. begin
  3746. if (not(cs_full_boolean_eval in current_settings.localswitches) or
  3747. (nf_short_bool in flags)) and
  3748. (nodetype in [andn,orn]) then
  3749. expectloc:=LOC_JUMP
  3750. else
  3751. begin
  3752. if nodetype in [ltn,lten,gtn,gten,equaln,unequaln] then
  3753. expectloc:=LOC_FLAGS
  3754. else
  3755. expectloc:=LOC_REGISTER;
  3756. end;
  3757. end
  3758. else
  3759. { Both are chars? only convert to shortstrings for addn }
  3760. if is_char(ld) then
  3761. begin
  3762. if nodetype=addn then
  3763. internalerror(200103291);
  3764. expectloc:=LOC_FLAGS;
  3765. end
  3766. else if (nodetype=muln) and
  3767. is_64bitint(resultdef) and
  3768. not use_generic_mul32to64 and
  3769. try_make_mul32to64 then
  3770. begin
  3771. { if the code generator can handle 32 to 64-bit muls,
  3772. we're done here }
  3773. expectloc:=LOC_REGISTER;
  3774. end
  3775. {$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
  3776. { is there a 64 bit type ? }
  3777. else if (torddef(ld).ordtype in [s64bit,u64bit,scurrency]) then
  3778. begin
  3779. result := first_add64bitint;
  3780. if assigned(result) then
  3781. exit;
  3782. if nodetype in [addn,subn,muln,andn,orn,xorn] then
  3783. expectloc:=LOC_REGISTER
  3784. else
  3785. expectloc:=LOC_JUMP;
  3786. end
  3787. {$else if defined(llvm) and cpu32bitalu}
  3788. { llvm does not support 128 bit math on 32 bit targets, which is
  3789. necessary for overflow checking 64 bit operations }
  3790. else if (torddef(ld).ordtype in [s64bit,u64bit,scurrency]) and
  3791. (cs_check_overflow in current_settings.localswitches) and
  3792. (nodetype in [addn,subn,muln]) then
  3793. begin
  3794. result := first_add64bitint;
  3795. if assigned(result) then
  3796. exit;
  3797. if nodetype in [addn,subn,muln,andn,orn,xorn] then
  3798. expectloc:=LOC_REGISTER
  3799. else
  3800. expectloc:=LOC_JUMP;
  3801. end
  3802. {$endif not(cpu64bitalu) and not(cpuhighleveltarget)}
  3803. { generic 32bit conversion }
  3804. else
  3805. begin
  3806. {$ifdef cpuneedsmulhelper}
  3807. if use_mul_helper then
  3808. begin
  3809. result := nil;
  3810. case torddef(resultdef).ordtype of
  3811. s8bit:
  3812. procname := 'fpc_mul_shortint';
  3813. u8bit:
  3814. procname := 'fpc_mul_byte';
  3815. s16bit:
  3816. procname := 'fpc_mul_integer';
  3817. u16bit:
  3818. procname := 'fpc_mul_word';
  3819. s32bit:
  3820. procname := 'fpc_mul_longint';
  3821. u32bit:
  3822. procname := 'fpc_mul_dword';
  3823. else
  3824. internalerror(2011022301);
  3825. end;
  3826. if cs_check_overflow in current_settings.localswitches then
  3827. procname:=procname+'_checkoverflow';
  3828. result := ccallnode.createintern(procname,
  3829. ccallparanode.create(right,
  3830. ccallparanode.create(left,nil)));
  3831. left := nil;
  3832. right := nil;
  3833. firstpass(result);
  3834. exit;
  3835. end;
  3836. {$endif cpuneedsmulhelper}
  3837. if nodetype in [addn,subn,muln,andn,orn,xorn] then
  3838. expectloc:=LOC_REGISTER
  3839. {$if not defined(cpuhighleveltarget)}
  3840. else if torddef(ld).size>sizeof(aint) then
  3841. expectloc:=LOC_JUMP
  3842. {$endif}
  3843. else
  3844. expectloc:=LOC_FLAGS;
  3845. end;
  3846. end
  3847. { left side a setdef, must be before string processing,
  3848. else array constructor can be seen as array of char (PFV) }
  3849. else if (ld.typ=setdef) then
  3850. begin
  3851. { small sets are handled inline by the compiler.
  3852. small set doesn't have support for adding ranges }
  3853. if is_smallset(ld) and
  3854. not(
  3855. (right.nodetype=setelementn) and
  3856. assigned(tsetelementnode(right).right)
  3857. ) then
  3858. begin
  3859. if nodetype in [ltn,lten,gtn,gten,equaln,unequaln] then
  3860. expectloc:=LOC_FLAGS
  3861. else
  3862. expectloc:=LOC_REGISTER;
  3863. end
  3864. else
  3865. begin
  3866. result := first_addset;
  3867. if assigned(result) then
  3868. exit;
  3869. expectloc:=LOC_CREFERENCE;
  3870. end;
  3871. end
  3872. { compare pchar by addresses like BP/Delphi }
  3873. else if is_pchar(ld) then
  3874. begin
  3875. if nodetype in [addn,subn,muln,andn,orn,xorn] then
  3876. result:=first_addpointer
  3877. else
  3878. result:=first_cmppointer;
  3879. end
  3880. { is one of the operands a string }
  3881. else if (ld.typ=stringdef) then
  3882. begin
  3883. if is_widestring(ld) then
  3884. begin
  3885. { this is only for add, the comparisaion is handled later }
  3886. expectloc:=LOC_REGISTER;
  3887. end
  3888. else if is_unicodestring(ld) then
  3889. begin
  3890. { this is only for add, the comparisaion is handled later }
  3891. expectloc:=LOC_REGISTER;
  3892. end
  3893. else if is_ansistring(ld) then
  3894. begin
  3895. { this is only for add, the comparisaion is handled later }
  3896. expectloc:=LOC_REGISTER;
  3897. end
  3898. else if is_longstring(ld) then
  3899. begin
  3900. { this is only for add, the comparisaion is handled later }
  3901. expectloc:=LOC_REFERENCE;
  3902. end
  3903. else
  3904. begin
  3905. {$ifdef addstringopt}
  3906. { can create a call which isn't handled by callparatemp }
  3907. if canbeaddsstringcharoptnode(self) then
  3908. begin
  3909. hp := genaddsstringcharoptnode(self);
  3910. pass_1 := hp;
  3911. exit;
  3912. end
  3913. else
  3914. {$endif addstringopt}
  3915. begin
  3916. { Fix right to be shortstring }
  3917. if is_char(right.resultdef) then
  3918. begin
  3919. inserttypeconv(right,cshortstringtype);
  3920. firstpass(right);
  3921. end;
  3922. end;
  3923. {$ifdef addstringopt}
  3924. { can create a call which isn't handled by callparatemp }
  3925. if canbeaddsstringcsstringoptnode(self) then
  3926. begin
  3927. hp := genaddsstringcsstringoptnode(self);
  3928. pass_1 := hp;
  3929. exit;
  3930. end;
  3931. {$endif addstringopt}
  3932. end;
  3933. { otherwise, let addstring convert everything }
  3934. result := first_addstring;
  3935. exit;
  3936. end
  3937. { is one a real float ? }
  3938. else if (rd.typ=floatdef) or (ld.typ=floatdef) then
  3939. begin
  3940. {$ifdef cpufpemu}
  3941. result:=first_addfloat;
  3942. if assigned(result) then
  3943. exit;
  3944. {$endif cpufpemu}
  3945. if nodetype in [addn,subn,muln,andn,orn,xorn] then
  3946. expectloc:=LOC_FPUREGISTER
  3947. else
  3948. expectloc:=LOC_FLAGS;
  3949. result:=try_fma(ld,rd);
  3950. if assigned(result) then
  3951. exit;
  3952. end
  3953. { pointer comperation and subtraction }
  3954. else if (ld.typ=pointerdef) then
  3955. begin
  3956. if nodetype in [addn,subn,muln,andn,orn,xorn] then
  3957. result:=first_addpointer
  3958. else
  3959. result:=first_cmppointer;
  3960. end
  3961. else if is_implicit_pointer_object_type(ld) then
  3962. begin
  3963. if ld.size>sizeof(aint) then
  3964. expectloc:=LOC_JUMP
  3965. else
  3966. expectloc:=LOC_FLAGS;
  3967. end
  3968. else if (ld.typ=classrefdef) then
  3969. begin
  3970. if ld.size>sizeof(aint) then
  3971. expectloc:=LOC_JUMP
  3972. else
  3973. expectloc:=LOC_FLAGS;
  3974. end
  3975. { support procvar=nil,procvar<>nil }
  3976. else if ((ld.typ=procvardef) and (rt=niln)) or
  3977. ((rd.typ=procvardef) and (lt=niln)) then
  3978. begin
  3979. if (ld.typ=procvardef) and (tprocvardef(ld).size>sizeof(aint)) or
  3980. (rd.typ=procvardef) and (tprocvardef(rd).size>sizeof(aint)) then
  3981. expectloc:=LOC_JUMP
  3982. else
  3983. expectloc:=LOC_FLAGS;
  3984. end
  3985. {$ifdef SUPPORT_MMX}
  3986. { mmx support, this must be before the zero based array
  3987. check }
  3988. else if (cs_mmx in current_settings.localswitches) and is_mmx_able_array(ld) and
  3989. is_mmx_able_array(rd) then
  3990. begin
  3991. expectloc:=LOC_MMXREGISTER;
  3992. end
  3993. {$endif SUPPORT_MMX}
  3994. else if (rd.typ=pointerdef) or (ld.typ=pointerdef) then
  3995. begin
  3996. result:=first_addpointer;
  3997. end
  3998. else if (rd.typ=procvardef) and
  3999. (ld.typ=procvardef) and
  4000. equal_defs(rd,ld) then
  4001. begin
  4002. if tprocvardef(ld).size>sizeof(aint) then
  4003. expectloc:=LOC_JUMP
  4004. else
  4005. expectloc:=LOC_FLAGS;
  4006. end
  4007. else if (ld.typ=enumdef) then
  4008. begin
  4009. if tenumdef(ld).size>sizeof(aint) then
  4010. expectloc:=LOC_JUMP
  4011. else
  4012. expectloc:=LOC_FLAGS;
  4013. end
  4014. {$ifdef SUPPORT_MMX}
  4015. else if (cs_mmx in current_settings.localswitches) and
  4016. is_mmx_able_array(ld) and
  4017. is_mmx_able_array(rd) then
  4018. begin
  4019. expectloc:=LOC_MMXREGISTER;
  4020. end
  4021. {$endif SUPPORT_MMX}
  4022. else if is_dynamic_array(ld) or is_dynamic_array(rd) then
  4023. begin
  4024. result:=first_adddynarray;
  4025. exit;
  4026. end
  4027. { the general solution is to convert to 32 bit int }
  4028. else
  4029. begin
  4030. expectloc:=LOC_REGISTER;
  4031. end;
  4032. end;
  4033. {$ifdef state_tracking}
  4034. function Taddnode.track_state_pass(exec_known:boolean):boolean;
  4035. var factval:Tnode;
  4036. begin
  4037. track_state_pass:=false;
  4038. if left.track_state_pass(exec_known) then
  4039. begin
  4040. track_state_pass:=true;
  4041. left.resultdef:=nil;
  4042. do_typecheckpass(left);
  4043. end;
  4044. factval:=aktstate.find_fact(left);
  4045. if factval<>nil then
  4046. begin
  4047. track_state_pass:=true;
  4048. left.destroy;
  4049. left:=factval.getcopy;
  4050. end;
  4051. if right.track_state_pass(exec_known) then
  4052. begin
  4053. track_state_pass:=true;
  4054. right.resultdef:=nil;
  4055. do_typecheckpass(right);
  4056. end;
  4057. factval:=aktstate.find_fact(right);
  4058. if factval<>nil then
  4059. begin
  4060. track_state_pass:=true;
  4061. right.destroy;
  4062. right:=factval.getcopy;
  4063. end;
  4064. end;
  4065. {$endif}
  4066. end.