nadd.pas 206 KB

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