nadd.pas 184 KB

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