hlcgobj.pas 213 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557455845594560456145624563456445654566456745684569457045714572457345744575457645774578457945804581458245834584458545864587458845894590459145924593459445954596459745984599460046014602460346044605460646074608460946104611461246134614461546164617461846194620462146224623462446254626462746284629463046314632463346344635463646374638463946404641464246434644464546464647464846494650465146524653465446554656465746584659466046614662466346644665466646674668466946704671467246734674467546764677467846794680468146824683468446854686468746884689469046914692469346944695469646974698469947004701470247034704470547064707470847094710471147124713471447154716471747184719472047214722472347244725472647274728472947304731473247334734473547364737473847394740474147424743474447454746474747484749475047514752475347544755475647574758475947604761476247634764476547664767476847694770477147724773477447754776477747784779478047814782478347844785478647874788478947904791479247934794479547964797479847994800480148024803480448054806480748084809481048114812481348144815481648174818481948204821482248234824482548264827482848294830483148324833483448354836483748384839484048414842484348444845484648474848484948504851485248534854485548564857485848594860486148624863486448654866486748684869487048714872487348744875487648774878487948804881488248834884488548864887488848894890489148924893489448954896489748984899490049014902490349044905490649074908490949104911491249134914491549164917491849194920492149224923492449254926492749284929493049314932493349344935493649374938493949404941494249434944494549464947494849494950495149524953495449554956495749584959496049614962496349644965496649674968496949704971497249734974497549764977497849794980498149824983498449854986498749884989499049914992499349944995499649974998499950005001500250035004500550065007500850095010501150125013
  1. {
  2. Copyright (c) 1998-2010 by Florian Klaempfl and Jonas Maebe
  3. Member of the Free Pascal development team
  4. This unit implements the basic high level code generator object
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. {# @abstract(Abstract code generator unit)
  19. Abstract high level code generator unit. This contains the base class
  20. that either lowers most code to the regular code generator, or that
  21. has to be implemented/overridden for higher level targets (such as LLVM).
  22. }
  23. unit hlcgobj;
  24. {$i fpcdefs.inc}
  25. { define hlcginline}
  26. interface
  27. uses
  28. cclasses,globtype,constexp,
  29. cpubase,cgbase,cgutils,parabase,
  30. aasmbase,aasmtai,aasmdata,aasmcpu,
  31. symconst,symtype,symsym,symdef,
  32. node,nutils
  33. ;
  34. type
  35. tsubsetloadopt = (SL_REG,SL_REGNOSRCMASK,SL_SETZERO,SL_SETMAX);
  36. preplaceregrec = ^treplaceregrec;
  37. treplaceregrec = record
  38. old, new: tregister;
  39. oldhi, newhi: tregister;
  40. ressym: tsym;
  41. { moved sym }
  42. sym : tabstractnormalvarsym;
  43. end;
  44. {# @abstract(Abstract high level code generator)
  45. This class implements an abstract instruction generator. All
  46. methods of this class are generic and are mapped to low level code
  47. generator methods by default. They have to be overridden for higher
  48. level targets
  49. }
  50. { thlcgobj }
  51. thlcgobj = class
  52. public
  53. {************************************************}
  54. { basic routines }
  55. constructor create;
  56. {# Initialize the register allocators needed for the codegenerator.}
  57. procedure init_register_allocators;virtual;
  58. {# Clean up the register allocators needed for the codegenerator.}
  59. procedure done_register_allocators;virtual;
  60. {# Set whether live_start or live_end should be updated when allocating registers, needed when e.g. generating initcode after the rest of the code. }
  61. procedure set_regalloc_live_range_direction(dir: TRADirection);virtual;
  62. {# Gets a register suitable to do integer operations on.}
  63. function getintregister(list:TAsmList;size:tdef):Tregister;virtual;
  64. {# Gets a register suitable to do integer operations on.}
  65. function getaddressregister(list:TAsmList;size:tdef):Tregister;virtual;
  66. function getfpuregister(list:TAsmList;size:tdef):Tregister;virtual;
  67. { warning: only works correctly for fpu types currently }
  68. function getmmregister(list:TAsmList;size:tdef):Tregister;virtual;
  69. function getflagregister(list:TAsmList;size:tdef):Tregister;virtual;
  70. function getregisterfordef(list: TAsmList;size:tdef):Tregister;virtual;
  71. {Does the generic cg need SIMD registers, like getmmxregister? Or should
  72. the cpu specific child cg object have such a method?}
  73. function uses_registers(rt:Tregistertype):boolean; inline;
  74. {# Get a specific register.}
  75. procedure getcpuregister(list:TAsmList;r:Tregister);virtual;
  76. procedure ungetcpuregister(list:TAsmList;r:Tregister);virtual;
  77. {# Get multiple registers specified.}
  78. procedure alloccpuregisters(list:TAsmList;rt:Tregistertype;const r:Tcpuregisterset);virtual;
  79. {# Free multiple registers specified.}
  80. procedure dealloccpuregisters(list:TAsmList;rt:Tregistertype;const r:Tcpuregisterset);virtual;
  81. procedure allocallcpuregisters(list:TAsmList);virtual;
  82. procedure deallocallcpuregisters(list:TAsmList);virtual;
  83. procedure do_register_allocation(list:TAsmList;headertai:tai); inline;
  84. procedure translate_register(var reg : tregister); inline;
  85. {# Returns the kind of register this type should be loaded in (it does not
  86. check whether this is actually possible, but if it's loaded in a register
  87. by the compiler for any purpose other than parameter passing/function
  88. result loading, this is the register type used }
  89. function def2regtyp(def: tdef): tregistertype; virtual;
  90. {# Returns a reference with its base address set from a pointer that
  91. has been loaded in a register.
  92. A generic version is provided. This routine should be overridden
  93. on platforms which support pointers with different sizes (for
  94. example i8086 near and far pointers) or require some other sort of
  95. special consideration when converting a pointer in a register to a
  96. reference.
  97. @param(ref where the result is returned)
  98. @param(regsize the type of the pointer, contained in the reg parameter)
  99. @param(reg register containing the value of a pointer)
  100. }
  101. procedure reference_reset_base(var ref: treference; regsize: tdef; reg: tregister; offset, alignment: longint); virtual;
  102. {# Emit a label to the instruction stream. }
  103. procedure a_label(list : TAsmList;l : tasmlabel); inline;
  104. {# Allocates register r by inserting a pai_realloc record }
  105. procedure a_reg_alloc(list : TAsmList;r : tregister); inline;
  106. {# Deallocates register r by inserting a pa_regdealloc record}
  107. procedure a_reg_dealloc(list : TAsmList;r : tregister); inline;
  108. { Synchronize register, make sure it is still valid }
  109. procedure a_reg_sync(list : TAsmList;r : tregister); inline;
  110. {# Pass a parameter, which is located in a register, to a routine.
  111. This routine should push/send the parameter to the routine, as
  112. required by the specific processor ABI and routine modifiers.
  113. It must generate register allocation information for the cgpara in
  114. case it consists of cpuregisters.
  115. @param(size size of the operand in the register)
  116. @param(r register source of the operand)
  117. @param(cgpara where the parameter will be stored)
  118. }
  119. procedure a_load_reg_cgpara(list : TAsmList;size : tdef;r : tregister;const cgpara : TCGPara);virtual;
  120. {# Pass a parameter, which is a constant, to a routine.
  121. A generic version is provided. This routine should
  122. be overridden for optimization purposes if the cpu
  123. permits directly sending this type of parameter.
  124. It must generate register allocation information for the cgpara in
  125. case it consists of cpuregisters.
  126. @param(size size of the operand in constant)
  127. @param(a value of constant to send)
  128. @param(cgpara where the parameter will be stored)
  129. }
  130. procedure a_load_const_cgpara(list : TAsmList;tosize : tdef;a : tcgint;const cgpara : TCGPara);virtual;
  131. {# Pass the value of a parameter, which is located in memory, to a routine.
  132. A generic version is provided. This routine should
  133. be overridden for optimization purposes if the cpu
  134. permits directly sending this type of parameter.
  135. It must generate register allocation information for the cgpara in
  136. case it consists of cpuregisters.
  137. @param(size size of the operand in constant)
  138. @param(r Memory reference of value to send)
  139. @param(cgpara where the parameter will be stored)
  140. }
  141. procedure a_load_ref_cgpara(list : TAsmList;size : tdef;const r : treference;const cgpara : TCGPara);virtual;
  142. {# Pass the value of a parameter, which can be located either in a register or memory location,
  143. to a routine.
  144. A generic version is provided.
  145. @param(l location of the operand to send)
  146. @param(nr parameter number (starting from one) of routine (from left to right))
  147. @param(cgpara where the parameter will be stored)
  148. }
  149. procedure a_load_loc_cgpara(list : TAsmList;size : tdef; const l : tlocation;const cgpara : TCGPara);virtual;
  150. {# Pass the address of a reference to a routine. This routine
  151. will calculate the address of the reference, and pass this
  152. calculated address as a parameter.
  153. It must generate register allocation information for the cgpara in
  154. case it consists of cpuregisters.
  155. A generic version is provided. This routine should
  156. be overridden for optimization purposes if the cpu
  157. permits directly sending this type of parameter.
  158. @param(fromsize type of the reference we are taking the address of)
  159. @param(tosize type of the pointer that we get as a result)
  160. @param(r reference to get address from)
  161. }
  162. procedure a_loadaddr_ref_cgpara(list : TAsmList;fromsize : tdef;const r : treference;const cgpara : TCGPara);virtual;
  163. { Remarks:
  164. * If a method specifies a size you have only to take care
  165. of that number of bits, i.e. load_const_reg with OP_8 must
  166. only load the lower 8 bit of the specified register
  167. the rest of the register can be undefined
  168. if necessary the compiler will call a method
  169. to zero or sign extend the register
  170. * The a_load_XX_XX with OP_64 needn't to be
  171. implemented for 32 bit
  172. processors, the code generator takes care of that
  173. * the addr size is for work with the natural pointer
  174. size
  175. * the procedures without fpu/mm are only for integer usage
  176. * normally the first location is the source and the
  177. second the destination
  178. }
  179. {# Emits instruction to call the method specified by symbol name.
  180. Returns the function result location.
  181. This routine must be overridden for each new target cpu.
  182. }
  183. function a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; forceresdef: tdef; weak: boolean): tcgpara;virtual;abstract;
  184. procedure a_call_reg(list : TAsmList;pd : tabstractprocdef;reg : tregister);virtual;abstract;
  185. { same as a_call_name, might be overridden on certain architectures to emit
  186. static calls without usage of a got trampoline }
  187. function a_call_name_static(list : TAsmList;pd : tprocdef;const s : TSymStr; forceresdef: tdef): tcgpara;virtual;
  188. { same as a_call_name, might be overridden on certain architectures to emit
  189. special static calls for inherited methods }
  190. procedure a_call_name_inherited(list : TAsmList;pd : tprocdef;const s : TSymStr);virtual;
  191. { move instructions }
  192. procedure a_load_const_reg(list : TAsmList;tosize : tdef;a : tcgint;register : tregister);virtual;abstract;
  193. procedure a_load_const_ref(list : TAsmList;tosize : tdef;a : tcgint;const ref : treference);virtual;
  194. procedure a_load_const_loc(list : TAsmList;tosize : tdef;a : tcgint;const loc : tlocation);virtual;
  195. procedure a_load_reg_ref(list : TAsmList;fromsize, tosize : tdef;register : tregister;const ref : treference);virtual;abstract;
  196. procedure a_load_reg_ref_unaligned(list : TAsmList;fromsize, tosize : tdef;register : tregister;const ref : treference);virtual;
  197. procedure a_load_reg_reg(list : TAsmList;fromsize, tosize : tdef;reg1,reg2 : tregister);virtual;abstract;
  198. procedure a_load_reg_loc(list : TAsmList;fromsize, tosize : tdef;reg : tregister;const loc: tlocation);virtual;
  199. procedure a_load_ref_reg(list : TAsmList;fromsize, tosize : tdef;const ref : treference;register : tregister);virtual;abstract;
  200. procedure a_load_ref_reg_unaligned(list : TAsmList;fromsize, tosize : tdef;const ref : treference;register : tregister);virtual;
  201. procedure a_load_ref_ref(list : TAsmList;fromsize, tosize : tdef;const sref : treference;const dref : treference);virtual;
  202. procedure a_load_loc_reg(list : TAsmList;fromsize, tosize : tdef; const loc: tlocation; reg : tregister);virtual;
  203. procedure a_load_loc_ref(list : TAsmList;fromsize, tosize: tdef; const loc: tlocation; const ref : treference);virtual;
  204. procedure a_load_loc_subsetreg(list : TAsmList;fromsize, tosubsetsize: tdef; const loc: tlocation; const sreg : tsubsetregister);virtual;
  205. procedure a_load_loc_subsetref(list : TAsmList;fromsize, tosubsetsize: tdef; const loc: tlocation; const sref : tsubsetreference);virtual;
  206. procedure a_loadaddr_ref_reg(list : TAsmList;fromsize, tosize : tdef;const ref : treference;r : tregister);virtual;abstract;
  207. { For subsetreg/ref, the def is the size of the packed element. The
  208. size of the register that holds the data is a tcgsize, and hence
  209. always must be an orddef of the corresponding size in practice }
  210. procedure a_load_subsetreg_reg(list : TAsmList; subsetsize, tosize: tdef; const sreg: tsubsetregister; destreg: tregister); virtual;
  211. procedure a_load_reg_subsetreg(list : TAsmList; fromsize, tosubsetsize: tdef; fromreg: tregister; const sreg: tsubsetregister); virtual;
  212. procedure a_load_subsetreg_subsetreg(list: TAsmlist; fromsubsetsize, tosubsetsize : tdef; const fromsreg, tosreg: tsubsetregister); virtual;
  213. procedure a_load_subsetreg_ref(list : TAsmList; fromsubsetsize, tosize: tdef; const sreg: tsubsetregister; const destref: treference); virtual;
  214. procedure a_load_ref_subsetreg(list : TAsmList; fromsize, tosubsetsize: tdef; const fromref: treference; const sreg: tsubsetregister); virtual;
  215. procedure a_load_const_subsetreg(list: TAsmlist; tosubsetsize: tdef; a: tcgint; const sreg: tsubsetregister); virtual;
  216. procedure a_load_subsetreg_loc(list: TAsmlist; fromsubsetsize, tosize: tdef; const sreg: tsubsetregister; const loc: tlocation); virtual;
  217. procedure a_load_subsetref_reg(list : TAsmList; fromsubsetsize, tosize: tdef; const sref: tsubsetreference; destreg: tregister); virtual;
  218. procedure a_load_reg_subsetref(list : TAsmList; fromsize, tosubsetsize: tdef; fromreg: tregister; const sref: tsubsetreference); virtual;
  219. procedure a_load_subsetref_subsetref(list: TAsmlist; fromsubsetsize, tosubsetsize : tdef; const fromsref, tosref: tsubsetreference); virtual;
  220. procedure a_load_subsetref_ref(list : TAsmList; fromsubsetsize, tosize: tdef; const sref: tsubsetreference; const destref: treference); virtual;
  221. procedure a_load_ref_subsetref(list : TAsmList; fromsize, tosubsetsize: tdef; const fromref: treference; const sref: tsubsetreference); virtual;
  222. procedure a_load_const_subsetref(list: TAsmlist; tosubsetsize: tdef; a: tcgint; const sref: tsubsetreference); virtual;
  223. procedure a_load_subsetref_loc(list: TAsmlist; fromsubsetsize, tosize: tdef; const sref: tsubsetreference; const loc: tlocation); virtual;
  224. procedure a_load_subsetref_subsetreg(list: TAsmlist; fromsubsetsize, tosubsetsize : tdef; const fromsref: tsubsetreference; const tosreg: tsubsetregister); virtual;
  225. procedure a_load_subsetreg_subsetref(list: TAsmlist; fromsubsetsize, tosubsetsize : tdef; const fromsreg: tsubsetregister; const tosref: tsubsetreference); virtual;
  226. { bit test instructions }
  227. procedure a_bit_test_reg_reg_reg(list : TAsmList; bitnumbersize,valuesize,destsize: tdef;bitnumber,value,destreg: tregister); virtual;
  228. procedure a_bit_test_const_ref_reg(list: TAsmList; fromsize, destsize: tdef; bitnumber: aint; const ref: treference; destreg: tregister); virtual;
  229. procedure a_bit_test_const_reg_reg(list: TAsmList; setregsize, destsize: tdef; bitnumber: aint; setreg, destreg: tregister); virtual;
  230. procedure a_bit_test_const_subsetreg_reg(list: TAsmList; fromsubsetsize, destsize: tdef; bitnumber: aint; const setreg: tsubsetregister; destreg: tregister); virtual;
  231. procedure a_bit_test_reg_ref_reg(list: TAsmList; bitnumbersize, refsize, destsize: tdef; bitnumber: tregister; const ref: treference; destreg: tregister); virtual;
  232. procedure a_bit_test_reg_loc_reg(list: TAsmList; bitnumbersize, locsize, destsize: tdef; bitnumber: tregister; const loc: tlocation; destreg: tregister);virtual;
  233. procedure a_bit_test_const_loc_reg(list: TAsmList; locsize, destsize: tdef; bitnumber: aint; const loc: tlocation; destreg: tregister);virtual;
  234. { bit set/clear instructions }
  235. procedure a_bit_set_reg_reg(list : TAsmList; doset: boolean; bitnumbersize, destsize: tdef; bitnumber,dest: tregister); virtual;
  236. procedure a_bit_set_const_ref(list: TAsmList; doset: boolean;destsize: tdef; bitnumber: tcgint; const ref: treference); virtual;
  237. procedure a_bit_set_const_reg(list: TAsmList; doset: boolean; destsize: tdef; bitnumber: tcgint; destreg: tregister); virtual;
  238. procedure a_bit_set_const_subsetreg(list: TAsmList; doset: boolean; destsize: tdef; bitnumber: tcgint; const destreg: tsubsetregister); virtual;
  239. procedure a_bit_set_reg_ref(list: TAsmList; doset: boolean; fromsize, tosize: tdef; bitnumber: tregister; const ref: treference); virtual;
  240. procedure a_bit_set_reg_loc(list: TAsmList; doset: boolean; regsize, tosize: tdef; bitnumber: tregister; const loc: tlocation);virtual;
  241. procedure a_bit_set_const_loc(list: TAsmList; doset: boolean; tosize: tdef; bitnumber: tcgint; const loc: tlocation);virtual;
  242. protected
  243. function get_call_result_cgpara(pd: tprocdef; forceresdef: tdef): tcgpara;
  244. procedure get_subsetref_load_info(const sref: tsubsetreference; out loadsize: torddef; out extra_load: boolean);
  245. procedure a_load_subsetref_regs_noindex(list: TAsmList; subsetsize: tdef; loadbitsize: byte; const sref: tsubsetreference; valuereg, extra_value_reg: tregister); virtual;
  246. procedure a_load_subsetref_regs_index(list: TAsmList; subsetsize: tdef; loadbitsize: byte; const sref: tsubsetreference; valuereg: tregister); virtual;
  247. procedure a_load_regconst_subsetref_intern(list : TAsmList; fromsize, subsetsize: tdef; fromreg: tregister; const sref: tsubsetreference; slopt: tsubsetloadopt); virtual;
  248. procedure a_load_regconst_subsetreg_intern(list : TAsmList; fromsize, subsetsize: tdef; fromreg: tregister; const sreg: tsubsetregister; slopt: tsubsetloadopt); virtual;
  249. { return a subsetref that represents bit "bitnumber" in ref, if ref
  250. has the type "refdef". The subsetref must be addressable via
  251. (unsigned) 8 bit access, unless all the *_bit_* methods are
  252. overloaded and use something else. }
  253. function get_bit_const_ref_sref(bitnumber: tcgint; refdef: tdef; const ref: treference): tsubsetreference;
  254. function get_bit_const_reg_sreg(setregsize: tdef; bitnumber: tcgint; setreg: tregister): tsubsetregister;
  255. function get_bit_reg_ref_sref(list: TAsmList; bitnumbersize, refsize: tdef; bitnumber: tregister; const ref: treference): tsubsetreference;
  256. public
  257. { bit scan instructions (still need transformation to thlcgobj) }
  258. procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: tdef; src, dst: tregister); virtual; abstract;
  259. { fpu move instructions }
  260. procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister); virtual; abstract;
  261. procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister); virtual; abstract;
  262. procedure a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference); virtual; abstract;
  263. procedure a_loadfpu_ref_ref(list: TAsmList; fromsize, tosize: tdef; const ref1,ref2: treference);virtual;
  264. procedure a_loadfpu_loc_reg(list: TAsmList; fromsize, tosize: tdef; const loc: tlocation; const reg: tregister);virtual;
  265. procedure a_loadfpu_reg_loc(list: TAsmList; fromsize, tosize: tdef; const reg: tregister; const loc: tlocation);virtual;
  266. procedure a_loadfpu_reg_cgpara(list : TAsmList;fromsize: tdef;const r : tregister;const cgpara : TCGPara);virtual;
  267. procedure a_loadfpu_ref_cgpara(list : TAsmList;fromsize : tdef;const ref : treference;const cgpara : TCGPara);virtual;
  268. { vector register move instructions }
  269. procedure a_loadmm_reg_reg(list: TAsmList; fromsize, tosize: tdef;reg1, reg2: tregister;shuffle : pmmshuffle); virtual; abstract;
  270. procedure a_loadmm_ref_reg(list: TAsmList; fromsize, tosize: tdef;const ref: treference; reg: tregister;shuffle : pmmshuffle); virtual; abstract;
  271. procedure a_loadmm_reg_ref(list: TAsmList; fromsize, tosize: tdef;reg: tregister; const ref: treference;shuffle : pmmshuffle); virtual; abstract;
  272. procedure a_loadmm_ref_ref(list: TAsmList; fromsize, tosize: tdef; const fromref, toref: treference; shuffle: pmmshuffle); virtual;
  273. { required for subsetreg/ref; still tcgsize rather than tdef because of reason mentioned above }
  274. procedure a_loadmm_loc_reg(list: TAsmList; fromsize, tosize: tdef; const loc: tlocation; const reg: tregister; shuffle : pmmshuffle);virtual;
  275. procedure a_loadmm_reg_loc(list: TAsmList; fromsize, tosize: tdef; const reg: tregister; const loc: tlocation;shuffle : pmmshuffle);virtual;
  276. procedure a_loadmm_reg_cgpara(list: TAsmList; fromsize: tdef; reg: tregister;const cgpara : TCGPara;shuffle : pmmshuffle); virtual;
  277. procedure a_loadmm_ref_cgpara(list: TAsmList; fromsize: tdef; const ref: treference;const cgpara : TCGPara;shuffle : pmmshuffle); virtual;
  278. procedure a_loadmm_loc_cgpara(list: TAsmList; fromsize: tdef; const loc: tlocation; const cgpara : TCGPara;shuffle : pmmshuffle); virtual;
  279. procedure a_opmm_reg_reg(list: TAsmList; Op: TOpCG; size : tdef;src,dst: tregister;shuffle : pmmshuffle); virtual; abstract;
  280. procedure a_opmm_ref_reg(list: TAsmList; Op: TOpCG; size : tdef;const ref: treference; reg: tregister;shuffle : pmmshuffle); virtual;
  281. procedure a_opmm_loc_reg(list: TAsmList; Op: TOpCG; size : tdef;const loc: tlocation; reg: tregister;shuffle : pmmshuffle); virtual;
  282. procedure a_opmm_reg_ref(list: TAsmList; Op: TOpCG; size : tdef;reg: tregister;const ref: treference; shuffle : pmmshuffle); virtual;
  283. { requires a temp that is interpreted in two different ways, and we
  284. don't have a way (yet) to tag a treference with tdef information so
  285. targets like LLVM can insert the necessary bitcast
  286. }
  287. procedure a_loadmm_intreg_reg(list: TAsmList; fromsize, tosize : tdef; intreg, mmreg: tregister; shuffle: pmmshuffle); virtual; abstract;
  288. procedure a_loadmm_reg_intreg(list: TAsmList; fromsize, tosize : tdef; mmreg, intreg: tregister; shuffle : pmmshuffle); virtual; abstract;
  289. { basic arithmetic operations }
  290. { note: for operators which require only one argument (not, neg), use }
  291. { the op_reg_reg, op_reg_ref or op_reg_loc methods and keep in mind }
  292. { that in this case the *second* operand is used as both source and }
  293. { destination (JM) }
  294. procedure a_op_const_reg(list : TAsmList; Op: TOpCG; size: tdef; a: tcgint; reg: TRegister); virtual; abstract;
  295. procedure a_op_const_ref(list : TAsmList; Op: TOpCG; size: tdef; a: tcgint; const ref: TReference); virtual;
  296. procedure a_op_const_subsetreg(list : TAsmList; Op : TOpCG; size, subsetsize : tdef; a : tcgint; const sreg: tsubsetregister); virtual;
  297. procedure a_op_const_subsetref(list : TAsmList; Op : TOpCG; size, subsetsize : tdef; a : tcgint; const sref: tsubsetreference); virtual;
  298. procedure a_op_const_loc(list : TAsmList; Op: TOpCG; size: tdef; a: tcgint; const loc: tlocation);virtual;
  299. procedure a_op_reg_reg(list : TAsmList; Op: TOpCG; size: tdef; reg1, reg2: TRegister); virtual; abstract;
  300. procedure a_op_reg_ref(list : TAsmList; Op: TOpCG; size: tdef; reg: TRegister; const ref: TReference); virtual;
  301. procedure a_op_ref_reg(list : TAsmList; Op: TOpCG; size: tdef; const ref: TReference; reg: TRegister); virtual;
  302. procedure a_op_reg_subsetreg(list: TAsmList; Op: TOpCG; opsize, destsubsetsize: tdef; reg: TRegister; const sreg: tsubsetregister); virtual;
  303. procedure a_op_reg_subsetref(list: TAsmList; Op: TOpCG; opsize, destsubsetsize: tdef; reg: TRegister; const sref: tsubsetreference); virtual;
  304. procedure a_op_reg_loc(list : TAsmList; Op: TOpCG; size: tdef; reg: tregister; const loc: tlocation);virtual;
  305. procedure a_op_ref_loc(list : TAsmList; Op: TOpCG; size: tdef; const ref: TReference; const loc: tlocation);virtual;
  306. { trinary operations for processors that support them, 'emulated' }
  307. { on others. None with "ref" arguments since I don't think there }
  308. { are any processors that support it (JM) }
  309. procedure a_op_const_reg_reg(list: TAsmList; op: TOpCg; size: tdef; a: tcgint; src, dst: tregister); virtual;
  310. procedure a_op_reg_reg_reg(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister); virtual;
  311. procedure a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; a: tcgint; src, dst: tregister;setflags : boolean;var ovloc : tlocation); virtual;
  312. procedure a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister;setflags : boolean;var ovloc : tlocation); virtual;
  313. { comparison operations }
  314. procedure a_cmp_const_reg_label(list : TAsmList;size : tdef;cmp_op : topcmp;a : tcgint;reg : tregister;
  315. l : tasmlabel);virtual;
  316. procedure a_cmp_const_ref_label(list : TAsmList;size : tdef;cmp_op : topcmp;a : tcgint;const ref : treference;
  317. l : tasmlabel); virtual;
  318. procedure a_cmp_const_loc_label(list: TAsmList; size: tdef;cmp_op: topcmp; a: tcgint; const loc: tlocation;
  319. l : tasmlabel);virtual;
  320. procedure a_cmp_reg_reg_label(list : TAsmList;size : tdef;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); virtual; abstract;
  321. procedure a_cmp_ref_reg_label(list : TAsmList;size : tdef;cmp_op : topcmp; const ref: treference; reg : tregister; l : tasmlabel); virtual;
  322. procedure a_cmp_reg_ref_label(list : TAsmList;size : tdef;cmp_op : topcmp;reg : tregister; const ref: treference; l : tasmlabel); virtual;
  323. procedure a_cmp_subsetreg_reg_label(list: TAsmList; fromsubsetsize, cmpsize: tdef; cmp_op: topcmp; const sreg: tsubsetregister; reg: tregister; l: tasmlabel); virtual;
  324. procedure a_cmp_subsetref_reg_label(list: TAsmList; fromsubsetsize, cmpsize: tdef; cmp_op: topcmp; const sref: tsubsetreference; reg: tregister; l: tasmlabel); virtual;
  325. procedure a_cmp_loc_reg_label(list : TAsmList;size : tdef;cmp_op : topcmp; const loc: tlocation; reg : tregister; l : tasmlabel);virtual;
  326. procedure a_cmp_reg_loc_label(list : TAsmList;size : tdef;cmp_op : topcmp; reg: tregister; const loc: tlocation; l : tasmlabel);
  327. procedure a_cmp_ref_loc_label(list: TAsmList; size: tdef;cmp_op: topcmp; const ref: treference; const loc: tlocation; l : tasmlabel);virtual;
  328. procedure a_jmp_always(list : TAsmList;l: tasmlabel); virtual;abstract;
  329. {$ifdef cpuflags}
  330. procedure a_jmp_flags(list : TAsmList;const f : TResFlags;l: tasmlabel); virtual; abstract;
  331. {# Depending on the value to check in the flags, either sets the register reg to one (if the flag is set)
  332. or zero (if the flag is cleared). The size parameter indicates the destination size register.
  333. }
  334. procedure g_flags2reg(list: TAsmList; size: tdef; const f: tresflags; reg: TRegister); virtual; abstract;
  335. procedure g_flags2ref(list: TAsmList; size: tdef; const f: tresflags; const ref:TReference); virtual; abstract;
  336. {$endif cpuflags}
  337. procedure g_maybe_testself(list : TAsmList; selftype: tdef; reg:tregister);
  338. // procedure g_maybe_testvmt(list : TAsmList;reg:tregister;objdef:tobjectdef);
  339. {# This should emit the opcode to copy len bytes from the source
  340. to destination.
  341. It must be overridden for each new target processor.
  342. @param(source Source reference of copy)
  343. @param(dest Destination reference of copy)
  344. }
  345. procedure g_concatcopy(list : TAsmList;size: tdef; const source,dest : treference);virtual;
  346. {# This should emit the opcode to copy len bytes from the an unaligned source
  347. to destination.
  348. It must be overridden for each new target processor.
  349. @param(source Source reference of copy)
  350. @param(dest Destination reference of copy)
  351. }
  352. procedure g_concatcopy_unaligned(list : TAsmList;size: tdef; const source,dest : treference);virtual;
  353. {# This should emit the opcode to a shortrstring from the source
  354. to destination.
  355. @param(source Source reference of copy)
  356. @param(dest Destination reference of copy)
  357. }
  358. procedure g_copyshortstring(list : TAsmList;const source,dest : treference;strdef:tstringdef);virtual;
  359. procedure g_copyvariant(list : TAsmList;const source,dest : treference;vardef:tvariantdef);virtual;
  360. procedure g_incrrefcount(list : TAsmList;t: tdef; const ref: treference);virtual;
  361. procedure g_initialize(list : TAsmList;t : tdef;const ref : treference);virtual;
  362. procedure g_finalize(list : TAsmList;t : tdef;const ref : treference);virtual;
  363. procedure g_array_rtti_helper(list: TAsmList; t: tdef; const ref: treference; const highloc: tlocation;
  364. const name: string);virtual;
  365. {# Generates range checking code. It is to note
  366. that this routine does not need to be overridden,
  367. as it takes care of everything.
  368. @param(p Node which contains the value to check)
  369. @param(todef Type definition of node to range check)
  370. }
  371. procedure g_rangecheck(list: TAsmList; const l:tlocation; fromdef,todef: tdef); virtual;
  372. {# Generates overflow checking code for a node }
  373. procedure g_overflowcheck(list: TAsmList; const Loc:tlocation; def:tdef); virtual; abstract;
  374. procedure g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;var ovloc : tlocation);virtual; abstract;
  375. procedure g_copyvaluepara_openarray(list : TAsmList;const ref:treference;const lenloc:tlocation;arrdef: tarraydef;destreg:tregister);virtual;
  376. procedure g_releasevaluepara_openarray(list : TAsmList;arrdef: tarraydef;const l:tlocation);virtual;
  377. {# Emits instructions when compilation is done in profile
  378. mode (this is set as a command line option). The default
  379. behavior does nothing, should be overridden as required.
  380. }
  381. procedure g_profilecode(list : TAsmList);virtual;
  382. {# Emits instruction for allocating @var(size) bytes at the stackpointer
  383. @param(size Number of bytes to allocate)
  384. }
  385. procedure g_stackpointer_alloc(list : TAsmList;size : longint);virtual; abstract;
  386. {# Emits instruction for allocating the locals in entry
  387. code of a routine. This is one of the first
  388. routine called in @var(genentrycode).
  389. @param(localsize Number of bytes to allocate as locals)
  390. }
  391. procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean);virtual; abstract;
  392. {# Emits instructions for returning from a subroutine.
  393. Should also restore the framepointer and stack.
  394. @param(parasize Number of bytes of parameters to deallocate from stack)
  395. }
  396. procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean);virtual; abstract;
  397. procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);virtual; abstract;
  398. procedure g_adjust_self_value(list:TAsmList;procdef: tprocdef;ioffset: aint);virtual; abstract;
  399. { generate a stub which only purpose is to pass control the given external method,
  400. setting up any additional environment before doing so (if required).
  401. The default implementation issues a jump instruction to the external name. }
  402. // procedure g_external_wrapper(list : TAsmList; procdef: tprocdef; const externalname: string); virtual;
  403. protected
  404. procedure g_allocload_reg_reg(list: TAsmList; regsize: tdef; const fromreg: tregister; out toreg: tregister; regtyp: tregistertype);
  405. public
  406. { create "safe copy" of a tlocation that can be used later: all
  407. registers used in the tlocation are copied to new ones, so that
  408. even if the original ones change, things stay the same (except if
  409. the original location was already a register, then the register is
  410. kept). Must only be used on lvalue locations.
  411. It's intended as some kind of replacement for a_loadaddr_ref_reg()
  412. for targets without pointers. }
  413. procedure g_reference_loc(list: TAsmList; def: tdef; const fromloc: tlocation; out toloc: tlocation); virtual;
  414. { routines migrated from ncgutil }
  415. procedure location_force_reg(list:TAsmList;var l:tlocation;src_size,dst_size:tdef;maybeconst:boolean);virtual;
  416. procedure location_force_fpureg(list:TAsmList;var l: tlocation;size: tdef;maybeconst:boolean);virtual;
  417. procedure location_force_mem(list:TAsmList;var l:tlocation;size:tdef);virtual;
  418. procedure location_force_mmregscalar(list:TAsmList;var l: tlocation;size:tdef;maybeconst:boolean);virtual;
  419. // procedure location_force_mmreg(list:TAsmList;var l: tlocation;size:tdef;maybeconst:boolean);virtual;abstract;
  420. { Retrieve the location of the data pointed to in location l, when the location is
  421. a register it is expected to contain the address of the data }
  422. procedure location_get_data_ref(list:TAsmList;def: tdef; const l:tlocation;var ref:treference;loadref:boolean; alignment: longint);virtual;
  423. procedure maketojumpbool(list:TAsmList; p : tnode);virtual;
  424. { if the result of n is a LOC_C(..)REGISTER, try to find the corresponding
  425. loadn and change its location to a new register (= SSA). In case reload
  426. is true, transfer the old to the new register }
  427. procedure maybe_change_load_node_reg(list: TAsmList; var n: tnode; reload: boolean); virtual;
  428. private
  429. function do_replace_node_regs(var n: tnode; para: pointer): foreachnoderesult; virtual;
  430. public
  431. procedure gen_proc_symbol(list:TAsmList);virtual;
  432. procedure gen_proc_symbol_end(list:TAsmList);virtual;
  433. procedure gen_initialize_code(list:TAsmList);virtual;
  434. procedure gen_finalize_code(list:TAsmList);virtual;
  435. procedure gen_entry_code(list:TAsmList);virtual;
  436. procedure gen_exit_code(list:TAsmList);virtual;
  437. protected
  438. { helpers called by gen_initialize_code/gen_finalize_code }
  439. procedure inittempvariables(list:TAsmList);virtual;
  440. procedure initialize_data(p:TObject;arg:pointer);virtual;
  441. procedure finalizetempvariables(list:TAsmList);virtual;
  442. procedure initialize_regvars(p:TObject;arg:pointer);virtual;
  443. procedure finalize_sym(asmlist:TAsmList;sym:tsym);virtual;
  444. { generates the code for finalisation of local variables }
  445. procedure finalize_local_vars(p:TObject;arg:pointer);virtual;
  446. { generates the code for finalization of static symtable and
  447. all local (static) typed consts }
  448. procedure finalize_static_data(p:TObject;arg:pointer);virtual;
  449. { generates the code for decrementing the reference count of parameters }
  450. procedure final_paras(p:TObject;arg:pointer);
  451. public
  452. procedure gen_load_para_value(list:TAsmList);virtual;
  453. protected
  454. { helpers called by gen_load_para_value }
  455. procedure g_copyvalueparas(p:TObject;arg:pointer);virtual;
  456. procedure gen_loadfpu_loc_cgpara(list: TAsmList; size: tdef; const l: tlocation;const cgpara: tcgpara;locintsize: longint);virtual;
  457. procedure init_paras(p:TObject;arg:pointer);
  458. protected
  459. { Some targets have to put "something" in the function result
  460. location if it's not initialised by the Pascal code, e.g.
  461. stack-based architectures. By default it does nothing }
  462. procedure gen_load_uninitialized_function_result(list: TAsmList; pd: tprocdef; resdef: tdef; const resloc: tcgpara);virtual;
  463. public
  464. { load a tlocation into a cgpara }
  465. procedure gen_load_loc_cgpara(list: TAsmList; vardef: tdef; const l: tlocation; const cgpara: tcgpara);virtual;
  466. { load a cgpara into a tlocation }
  467. procedure gen_load_cgpara_loc(list: TAsmList; vardef: tdef; const para: TCGPara; var destloc: tlocation; reusepara: boolean);virtual;
  468. { load the function return value into the ABI-defined function return location }
  469. procedure gen_load_return_value(list:TAsmList);virtual;
  470. { extras refactored from other units }
  471. { queue the code/data generated for a procedure for writing out to
  472. the assembler/object file }
  473. procedure record_generated_code_for_procdef(pd: tprocdef; code, data: TAsmList); virtual;
  474. { generate a call to a routine in the system unit }
  475. function g_call_system_proc(list: TAsmList; const procname: string; forceresdef: tdef): tcgpara;
  476. function g_call_system_proc(list: TAsmList; pd: tprocdef; forceresdef: tdef): tcgpara;
  477. protected
  478. function g_call_system_proc_intern(list: TAsmList; pd: tprocdef; forceresdef: tdef): tcgpara; virtual;
  479. public
  480. { Generate code to exit an unwind-protected region. The default implementation
  481. produces a simple jump to destination label. }
  482. procedure g_local_unwind(list: TAsmList; l: TAsmLabel);virtual;abstract;
  483. end;
  484. var
  485. {# Main high level code generator class }
  486. hlcg : thlcgobj;
  487. procedure destroy_hlcodegen;
  488. implementation
  489. uses
  490. globals,systems,
  491. fmodule,export,
  492. verbose,defutil,paramgr,
  493. symbase,symtable,
  494. nbas,ncon,nld,ncgrtti,pass_1,pass_2,
  495. cpuinfo,cgobj,tgobj,cutils,procinfo,
  496. {$ifdef x86}
  497. cgx86,
  498. {$endif x86}
  499. ncgutil,ngenutil;
  500. procedure destroy_hlcodegen;
  501. begin
  502. hlcg.free;
  503. hlcg:=nil;
  504. destroy_codegen;
  505. end;
  506. { thlcgobj }
  507. constructor thlcgobj.create;
  508. begin
  509. end;
  510. procedure thlcgobj.init_register_allocators;
  511. begin
  512. cg.init_register_allocators;
  513. end;
  514. procedure thlcgobj.done_register_allocators;
  515. begin
  516. cg.done_register_allocators;
  517. end;
  518. procedure thlcgobj.set_regalloc_live_range_direction(dir: TRADirection);
  519. begin
  520. cg.set_regalloc_live_range_direction(dir);
  521. end;
  522. function thlcgobj.getintregister(list: TAsmList; size: tdef): Tregister;
  523. begin
  524. result:=cg.getintregister(list,def_cgsize(size));
  525. end;
  526. function thlcgobj.getaddressregister(list: TAsmList; size: tdef): Tregister;
  527. begin
  528. result:=cg.getaddressregister(list);
  529. end;
  530. function thlcgobj.getfpuregister(list: TAsmList; size: tdef): Tregister;
  531. begin
  532. result:=cg.getfpuregister(list,def_cgsize(size));
  533. end;
  534. function thlcgobj.getmmregister(list: TAsmList; size: tdef): Tregister;
  535. begin
  536. result:=cg.getmmregister(list,def_cgsize(size));
  537. end;
  538. function thlcgobj.getflagregister(list: TAsmList; size: tdef): Tregister;
  539. begin
  540. result:=cg.getflagregister(list,def_cgsize(size));
  541. end;
  542. function thlcgobj.getregisterfordef(list: TAsmList; size: tdef): Tregister;
  543. begin
  544. case def2regtyp(size) of
  545. R_INTREGISTER:
  546. result:=getintregister(list,size);
  547. R_ADDRESSREGISTER:
  548. result:=getaddressregister(list,size);
  549. R_FPUREGISTER:
  550. result:=getfpuregister(list,size);
  551. R_MMREGISTER:
  552. result:=getmmregister(list,size);
  553. else
  554. internalerror(2010122901);
  555. end;
  556. end;
  557. function thlcgobj.uses_registers(rt: Tregistertype): boolean;
  558. begin
  559. result:=cg.uses_registers(rt);
  560. end;
  561. procedure thlcgobj.getcpuregister(list: TAsmList; r: Tregister);
  562. begin
  563. cg.getcpuregister(list,r);
  564. end;
  565. procedure thlcgobj.ungetcpuregister(list: TAsmList; r: Tregister);
  566. begin
  567. cg.ungetcpuregister(list,r);
  568. end;
  569. procedure thlcgobj.alloccpuregisters(list: TAsmList; rt: Tregistertype; const r: Tcpuregisterset);
  570. begin
  571. cg.alloccpuregisters(list,rt,r);
  572. end;
  573. procedure thlcgobj.dealloccpuregisters(list: TAsmList; rt: Tregistertype; const r: Tcpuregisterset);
  574. begin
  575. cg.dealloccpuregisters(list,rt,r);
  576. end;
  577. procedure thlcgobj.allocallcpuregisters(list: TAsmList);
  578. begin
  579. cg.allocallcpuregisters(list);
  580. end;
  581. procedure thlcgobj.deallocallcpuregisters(list: TAsmList);
  582. begin
  583. cg.deallocallcpuregisters(list);
  584. end;
  585. procedure thlcgobj.do_register_allocation(list: TAsmList; headertai: tai);
  586. begin
  587. cg.do_register_allocation(list,headertai);
  588. end;
  589. procedure thlcgobj.translate_register(var reg: tregister);
  590. begin
  591. cg.translate_register(reg);
  592. end;
  593. function thlcgobj.def2regtyp(def: tdef): tregistertype;
  594. begin
  595. case def.typ of
  596. enumdef,
  597. orddef,
  598. recorddef,
  599. setdef:
  600. result:=R_INTREGISTER;
  601. stringdef,
  602. pointerdef,
  603. classrefdef,
  604. objectdef,
  605. procvardef,
  606. procdef,
  607. arraydef,
  608. formaldef:
  609. result:=R_ADDRESSREGISTER;
  610. floatdef:
  611. if use_vectorfpu(def) then
  612. result:=R_MMREGISTER
  613. else if cs_fp_emulation in current_settings.moduleswitches then
  614. result:=R_INTREGISTER
  615. else
  616. result:=R_FPUREGISTER;
  617. filedef,
  618. variantdef:
  619. internalerror(2010120507);
  620. else
  621. internalerror(2010120506);
  622. end;
  623. end;
  624. procedure thlcgobj.reference_reset_base(var ref: treference; regsize: tdef;
  625. reg: tregister; offset, alignment: longint);
  626. begin
  627. reference_reset(ref,alignment);
  628. ref.base:=reg;
  629. ref.offset:=offset;
  630. end;
  631. procedure thlcgobj.a_label(list: TAsmList; l: tasmlabel); inline;
  632. begin
  633. cg.a_label(list,l);
  634. end;
  635. procedure thlcgobj.a_reg_alloc(list: TAsmList; r: tregister);
  636. begin
  637. cg.a_reg_alloc(list,r);
  638. end;
  639. procedure thlcgobj.a_reg_dealloc(list: TAsmList; r: tregister);
  640. begin
  641. cg.a_reg_dealloc(list,r);
  642. end;
  643. procedure thlcgobj.a_reg_sync(list: TAsmList; r: tregister);
  644. begin
  645. cg.a_reg_sync(list,r);
  646. end;
  647. procedure thlcgobj.a_load_reg_cgpara(list: TAsmList; size: tdef; r: tregister; const cgpara: TCGPara);
  648. var
  649. ref: treference;
  650. tmpreg : tregister;
  651. begin
  652. cgpara.check_simple_location;
  653. paramanager.alloccgpara(list,cgpara);
  654. if cgpara.location^.shiftval<0 then
  655. begin
  656. tmpreg:=getintregister(list,cgpara.location^.def);
  657. a_op_const_reg_reg(list,OP_SHL,cgpara.location^.def,-cgpara.location^.shiftval,r,tmpreg);
  658. r:=tmpreg;
  659. end;
  660. case cgpara.location^.loc of
  661. LOC_REGISTER,LOC_CREGISTER:
  662. a_load_reg_reg(list,size,cgpara.location^.def,r,cgpara.location^.register);
  663. LOC_REFERENCE,LOC_CREFERENCE:
  664. begin
  665. reference_reset_base(ref,voidstackpointertype,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment);
  666. a_load_reg_ref(list,size,cgpara.location^.def,r,ref);
  667. end;
  668. LOC_MMREGISTER,LOC_CMMREGISTER:
  669. a_loadmm_intreg_reg(list,size,cgpara.location^.def,r,cgpara.location^.register,mms_movescalar);
  670. LOC_FPUREGISTER,LOC_CFPUREGISTER:
  671. begin
  672. tg.gethltemp(list,size,size.size,tt_normal,ref);
  673. a_load_reg_ref(list,size,cgpara.location^.def,r,ref);
  674. a_loadfpu_ref_cgpara(list,cgpara.location^.def,ref,cgpara);
  675. tg.ungettemp(list,ref);
  676. end
  677. else
  678. internalerror(2010120415);
  679. end;
  680. end;
  681. procedure thlcgobj.a_load_const_cgpara(list: TAsmList; tosize: tdef; a: tcgint; const cgpara: TCGPara);
  682. var
  683. ref : treference;
  684. begin
  685. cgpara.check_simple_location;
  686. paramanager.alloccgpara(list,cgpara);
  687. if cgpara.location^.shiftval<0 then
  688. a:=a shl -cgpara.location^.shiftval;
  689. case cgpara.location^.loc of
  690. LOC_REGISTER,LOC_CREGISTER:
  691. a_load_const_reg(list,cgpara.location^.def,a,cgpara.location^.register);
  692. LOC_REFERENCE,LOC_CREFERENCE:
  693. begin
  694. reference_reset_base(ref,voidstackpointertype,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment);
  695. a_load_const_ref(list,cgpara.location^.def,a,ref);
  696. end
  697. else
  698. internalerror(2010120416);
  699. end;
  700. end;
  701. procedure thlcgobj.a_load_ref_cgpara(list: TAsmList; size: tdef; const r: treference; const cgpara: TCGPara);
  702. var
  703. tmpref, ref: treference;
  704. tmpreg: tregister;
  705. location: pcgparalocation;
  706. orgsizeleft,
  707. sizeleft: tcgint;
  708. reghasvalue: boolean;
  709. begin
  710. location:=cgpara.location;
  711. tmpref:=r;
  712. sizeleft:=cgpara.intsize;
  713. while assigned(location) do
  714. begin
  715. paramanager.allocparaloc(list,location);
  716. case location^.loc of
  717. LOC_REGISTER,LOC_CREGISTER:
  718. begin
  719. { Parameter locations are often allocated in multiples of
  720. entire registers. If a parameter only occupies a part of
  721. such a register (e.g. a 16 bit int on a 32 bit
  722. architecture), the size of this parameter can only be
  723. determined by looking at the "size" parameter of this
  724. method -> if the size parameter is <= sizeof(aint), then
  725. we check that there is only one parameter location and
  726. then use this "size" to load the value into the parameter
  727. location }
  728. if (def_cgsize(size)<>OS_NO) and
  729. (size.size<=sizeof(aint)) then
  730. begin
  731. cgpara.check_simple_location;
  732. a_load_ref_reg(list,size,location^.def,tmpref,location^.register);
  733. if location^.shiftval<0 then
  734. a_op_const_reg(list,OP_SHL,location^.def,-location^.shiftval,location^.register);
  735. end
  736. { there's a lot more data left, and the current paraloc's
  737. register is entirely filled with part of that data }
  738. else if (sizeleft>sizeof(aint)) then
  739. begin
  740. a_load_ref_reg(list,location^.def,location^.def,tmpref,location^.register);
  741. end
  742. { we're at the end of the data, and it can be loaded into
  743. the current location's register with a single regular
  744. load }
  745. else if sizeleft in [1,2,4,8] then
  746. begin
  747. { don't use cgsize_orddef(int_cgsize(sizeleft)) as fromdef,
  748. because that may be larger than location^.register in
  749. case of padding at the end of a record }
  750. a_load_ref_reg(list,location^.def,location^.def,tmpref,location^.register);
  751. if location^.shiftval<0 then
  752. a_op_const_reg(list,OP_SHL,location^.def,-location^.shiftval,location^.register);
  753. end
  754. { we're at the end of the data, and we need multiple loads
  755. to get it in the register because it's an irregular size }
  756. else
  757. begin
  758. { should be the last part }
  759. if assigned(location^.next) then
  760. internalerror(2010052907);
  761. { load the value piecewise to get it into the register }
  762. orgsizeleft:=sizeleft;
  763. reghasvalue:=false;
  764. {$ifdef cpu64bitalu}
  765. if sizeleft>=4 then
  766. begin
  767. a_load_ref_reg(list,u32inttype,location^.def,tmpref,location^.register);
  768. dec(sizeleft,4);
  769. if target_info.endian=endian_big then
  770. a_op_const_reg(list,OP_SHL,location^.def,sizeleft*8,location^.register);
  771. inc(tmpref.offset,4);
  772. reghasvalue:=true;
  773. end;
  774. {$endif cpu64bitalu}
  775. if sizeleft>=2 then
  776. begin
  777. tmpreg:=getintregister(list,location^.def);
  778. a_load_ref_reg(list,u16inttype,location^.def,tmpref,tmpreg);
  779. dec(sizeleft,2);
  780. if reghasvalue then
  781. begin
  782. if target_info.endian=endian_big then
  783. a_op_const_reg(list,OP_SHL,location^.def,sizeleft*8,tmpreg)
  784. else
  785. a_op_const_reg(list,OP_SHL,location^.def,(orgsizeleft-(sizeleft+2))*8,tmpreg);
  786. a_op_reg_reg(list,OP_OR,location^.def,tmpreg,location^.register);
  787. end
  788. else
  789. begin
  790. if target_info.endian=endian_big then
  791. a_op_const_reg_reg(list,OP_SHL,location^.def,sizeleft*8,tmpreg,location^.register)
  792. else
  793. a_load_reg_reg(list,location^.def,location^.def,tmpreg,location^.register);
  794. end;
  795. inc(tmpref.offset,2);
  796. reghasvalue:=true;
  797. end;
  798. if sizeleft=1 then
  799. begin
  800. tmpreg:=getintregister(list,location^.def);
  801. a_load_ref_reg(list,u8inttype,location^.def,tmpref,tmpreg);
  802. dec(sizeleft,1);
  803. if reghasvalue then
  804. begin
  805. if target_info.endian=endian_little then
  806. a_op_const_reg(list,OP_SHL,location^.def,(orgsizeleft-(sizeleft+1))*8,tmpreg);
  807. a_op_reg_reg(list,OP_OR,location^.def,tmpreg,location^.register)
  808. end
  809. else
  810. a_load_reg_reg(list,location^.def,location^.def,tmpreg,location^.register);
  811. inc(tmpref.offset);
  812. end;
  813. if location^.shiftval<0 then
  814. a_op_const_reg(list,OP_SHL,location^.def,-location^.shiftval,location^.register);
  815. { the loop will already adjust the offset and sizeleft }
  816. dec(tmpref.offset,orgsizeleft);
  817. sizeleft:=orgsizeleft;
  818. end;
  819. end;
  820. LOC_REFERENCE,LOC_CREFERENCE:
  821. begin
  822. if assigned(location^.next) then
  823. internalerror(2010052906);
  824. reference_reset_base(ref,voidstackpointertype,location^.reference.index,location^.reference.offset,newalignment(cgpara.alignment,cgpara.intsize-sizeleft));
  825. if (def_cgsize(size)<>OS_NO) and
  826. (size.size=sizeleft) and
  827. (sizeleft<=sizeof(aint)) then
  828. a_load_ref_ref(list,size,location^.def,tmpref,ref)
  829. else
  830. { use concatcopy, because the parameter can be larger than }
  831. { what the OS_* constants can handle }
  832. g_concatcopy(list,location^.def,tmpref,ref);
  833. end;
  834. LOC_MMREGISTER,LOC_CMMREGISTER:
  835. begin
  836. case location^.size of
  837. OS_F32,
  838. OS_F64,
  839. OS_F128:
  840. a_loadmm_ref_reg(list,location^.def,location^.def,tmpref,location^.register,mms_movescalar);
  841. OS_M8..OS_M128,
  842. OS_MS8..OS_MS128:
  843. a_loadmm_ref_reg(list,location^.def,location^.def,tmpref,location^.register,nil);
  844. else
  845. internalerror(2010053101);
  846. end;
  847. end
  848. else
  849. internalerror(2014032101);
  850. end;
  851. inc(tmpref.offset,tcgsize2size[location^.size]);
  852. dec(sizeleft,tcgsize2size[location^.size]);
  853. location:=location^.next;
  854. end;
  855. end;
  856. procedure thlcgobj.a_load_loc_cgpara(list: TAsmList; size: tdef; const l: tlocation; const cgpara: TCGPara);
  857. begin
  858. case l.loc of
  859. LOC_REGISTER,
  860. LOC_CREGISTER :
  861. a_load_reg_cgpara(list,size,l.register,cgpara);
  862. LOC_CONSTANT :
  863. a_load_const_cgpara(list,size,l.value,cgpara);
  864. LOC_CREFERENCE,
  865. LOC_REFERENCE :
  866. a_load_ref_cgpara(list,size,l.reference,cgpara);
  867. else
  868. internalerror(2010120419);
  869. end;
  870. end;
  871. procedure thlcgobj.a_loadaddr_ref_cgpara(list: TAsmList; fromsize: tdef; const r: treference; const cgpara: TCGPara);
  872. var
  873. hr : tregister;
  874. begin
  875. cgpara.check_simple_location;
  876. if cgpara.location^.loc in [LOC_CREGISTER,LOC_REGISTER] then
  877. begin
  878. paramanager.allocparaloc(list,cgpara.location);
  879. a_loadaddr_ref_reg(list,fromsize,cgpara.location^.def,r,cgpara.location^.register)
  880. end
  881. else
  882. begin
  883. hr:=getaddressregister(list,cgpara.def);
  884. a_loadaddr_ref_reg(list,fromsize,cgpara.location^.def,r,hr);
  885. a_load_reg_cgpara(list,cgpara.def,hr,cgpara);
  886. end;
  887. end;
  888. function thlcgobj.a_call_name_static(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef): tcgpara;
  889. begin
  890. result:=a_call_name(list,pd,s,forceresdef,false);
  891. end;
  892. procedure thlcgobj.a_call_name_inherited(list: TAsmList; pd: tprocdef; const s: TSymStr);
  893. begin
  894. a_call_name(list,pd,s,nil,false);
  895. end;
  896. procedure thlcgobj.a_load_const_ref(list: TAsmList; tosize: tdef; a: tcgint; const ref: treference);
  897. var
  898. tmpreg: tregister;
  899. begin
  900. tmpreg:=getintregister(list,tosize);
  901. a_load_const_reg(list,tosize,a,tmpreg);
  902. a_load_reg_ref(list,tosize,tosize,tmpreg,ref);
  903. end;
  904. procedure thlcgobj.a_load_const_loc(list: TAsmList; tosize: tdef; a: tcgint; const loc: tlocation);
  905. begin
  906. case loc.loc of
  907. LOC_REFERENCE,LOC_CREFERENCE:
  908. a_load_const_ref(list,tosize,a,loc.reference);
  909. LOC_REGISTER,LOC_CREGISTER:
  910. a_load_const_reg(list,tosize,a,loc.register);
  911. LOC_SUBSETREG,LOC_CSUBSETREG:
  912. a_load_const_subsetreg(list,tosize,a,loc.sreg);
  913. LOC_SUBSETREF,LOC_CSUBSETREF:
  914. a_load_const_subsetref(list,tosize,a,loc.sref);
  915. else
  916. internalerror(2010120401);
  917. end;
  918. end;
  919. procedure thlcgobj.a_load_reg_ref_unaligned(list: TAsmList; fromsize, tosize: tdef; register: tregister; const ref: treference);
  920. begin
  921. a_load_reg_ref(list,fromsize,tosize,register,ref);
  922. end;
  923. procedure thlcgobj.a_load_reg_loc(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const loc: tlocation);
  924. begin
  925. case loc.loc of
  926. LOC_REFERENCE,LOC_CREFERENCE:
  927. a_load_reg_ref(list,fromsize,tosize,reg,loc.reference);
  928. LOC_REGISTER,LOC_CREGISTER:
  929. a_load_reg_reg(list,fromsize,tosize,reg,loc.register);
  930. LOC_SUBSETREG,LOC_CSUBSETREG:
  931. a_load_reg_subsetreg(list,fromsize,tosize,reg,loc.sreg);
  932. LOC_SUBSETREF,LOC_CSUBSETREF:
  933. a_load_reg_subsetref(list,fromsize,tosize,reg,loc.sref);
  934. LOC_MMREGISTER,LOC_CMMREGISTER:
  935. a_loadmm_intreg_reg(list,fromsize,tosize,reg,loc.register,mms_movescalar);
  936. else
  937. internalerror(2010120402);
  938. end;
  939. end;
  940. procedure thlcgobj.a_load_ref_reg_unaligned(list: TAsmList; fromsize, tosize: tdef; const ref: treference; register: tregister);
  941. begin
  942. a_load_ref_reg(list,fromsize,tosize,ref,register);
  943. end;
  944. procedure thlcgobj.a_load_ref_ref(list: TAsmList; fromsize, tosize: tdef; const sref: treference; const dref: treference);
  945. var
  946. tmpreg: tregister;
  947. begin
  948. { verify if we have the same reference }
  949. if references_equal(sref,dref) then
  950. exit;
  951. tmpreg:=getintregister(list,tosize);
  952. a_load_ref_reg(list,fromsize,tosize,sref,tmpreg);
  953. a_load_reg_ref(list,tosize,tosize,tmpreg,dref);
  954. end;
  955. procedure thlcgobj.a_load_loc_reg(list: TAsmList; fromsize, tosize: tdef; const loc: tlocation; reg: tregister);
  956. begin
  957. case loc.loc of
  958. LOC_REFERENCE,LOC_CREFERENCE:
  959. a_load_ref_reg(list,fromsize,tosize,loc.reference,reg);
  960. LOC_REGISTER,LOC_CREGISTER:
  961. a_load_reg_reg(list,fromsize,tosize,loc.register,reg);
  962. LOC_CONSTANT:
  963. a_load_const_reg(list,tosize,loc.value,reg);
  964. LOC_SUBSETREG,LOC_CSUBSETREG:
  965. a_load_subsetreg_reg(list,fromsize,tosize,loc.sreg,reg);
  966. LOC_SUBSETREF,LOC_CSUBSETREF:
  967. a_load_subsetref_reg(list,fromsize,tosize,loc.sref,reg);
  968. else
  969. internalerror(2010120201);
  970. end;
  971. end;
  972. procedure thlcgobj.a_load_loc_ref(list: TAsmList; fromsize, tosize: tdef; const loc: tlocation; const ref: treference);
  973. begin
  974. case loc.loc of
  975. LOC_REFERENCE,LOC_CREFERENCE:
  976. a_load_ref_ref(list,fromsize,tosize,loc.reference,ref);
  977. LOC_REGISTER,LOC_CREGISTER:
  978. a_load_reg_ref(list,fromsize,tosize,loc.register,ref);
  979. LOC_CONSTANT:
  980. a_load_const_ref(list,tosize,loc.value,ref);
  981. LOC_SUBSETREG,LOC_CSUBSETREG:
  982. a_load_subsetreg_ref(list,fromsize,tosize,loc.sreg,ref);
  983. LOC_SUBSETREF,LOC_CSUBSETREF:
  984. a_load_subsetref_ref(list,fromsize,tosize,loc.sref,ref);
  985. else
  986. internalerror(2010120403);
  987. end;
  988. end;
  989. procedure thlcgobj.a_load_loc_subsetreg(list: TAsmList; fromsize, tosubsetsize: tdef; const loc: tlocation; const sreg: tsubsetregister);
  990. begin
  991. case loc.loc of
  992. LOC_REFERENCE,LOC_CREFERENCE:
  993. a_load_ref_subsetreg(list,fromsize,tosubsetsize,loc.reference,sreg);
  994. LOC_REGISTER,LOC_CREGISTER:
  995. a_load_reg_subsetreg(list,fromsize,tosubsetsize,loc.register,sreg);
  996. LOC_CONSTANT:
  997. a_load_const_subsetreg(list,tosubsetsize,loc.value,sreg);
  998. LOC_SUBSETREG,LOC_CSUBSETREG:
  999. a_load_subsetreg_subsetreg(list,fromsize,tosubsetsize,loc.sreg,sreg);
  1000. LOC_SUBSETREF,LOC_CSUBSETREF:
  1001. a_load_subsetref_subsetreg(list,fromsize,tosubsetsize,loc.sref,sreg);
  1002. else
  1003. internalerror(2010120404);
  1004. end;
  1005. end;
  1006. procedure thlcgobj.a_load_loc_subsetref(list: TAsmList; fromsize, tosubsetsize: tdef; const loc: tlocation; const sref: tsubsetreference);
  1007. begin
  1008. case loc.loc of
  1009. LOC_REFERENCE,LOC_CREFERENCE:
  1010. a_load_ref_subsetref(list,fromsize,tosubsetsize,loc.reference,sref);
  1011. LOC_REGISTER,LOC_CREGISTER:
  1012. a_load_reg_subsetref(list,fromsize,tosubsetsize,loc.register,sref);
  1013. LOC_CONSTANT:
  1014. a_load_const_subsetref(list,tosubsetsize,loc.value,sref);
  1015. LOC_SUBSETREG,LOC_CSUBSETREG:
  1016. a_load_subsetreg_subsetref(list,fromsize,tosubsetsize,loc.sreg,sref);
  1017. LOC_SUBSETREF,LOC_CSUBSETREF:
  1018. a_load_subsetref_subsetref(list,fromsize,tosubsetsize,loc.sref,sref);
  1019. else
  1020. internalerror(2010120405);
  1021. end;
  1022. end;
  1023. {$push}
  1024. {$r-,q-}
  1025. procedure thlcgobj.a_load_subsetreg_reg(list: TAsmList; subsetsize, tosize: tdef; const sreg: tsubsetregister; destreg: tregister);
  1026. var
  1027. subsetregdef: torddef;
  1028. bitmask: aword;
  1029. tmpreg,
  1030. subsetsizereg: tregister;
  1031. stopbit: byte;
  1032. begin
  1033. subsetregdef:=cgsize_orddef(sreg.subsetregsize);
  1034. tmpreg:=getintregister(list,subsetregdef);
  1035. if is_signed(subsetsize) then
  1036. begin
  1037. { sign extend in case the value has a bitsize mod 8 <> 0 }
  1038. { both instructions will be optimized away if not }
  1039. a_op_const_reg_reg(list,OP_SHL,subsetregdef,(tcgsize2size[sreg.subsetregsize]*8)-sreg.startbit-sreg.bitlen,sreg.subsetreg,tmpreg);
  1040. a_op_const_reg(list,OP_SAR,subsetregdef,(tcgsize2size[sreg.subsetregsize]*8)-sreg.bitlen,tmpreg);
  1041. end
  1042. else
  1043. begin
  1044. a_op_const_reg_reg(list,OP_SHR,subsetregdef,sreg.startbit,sreg.subsetreg,tmpreg);
  1045. stopbit:=sreg.startbit+sreg.bitlen;
  1046. // on x86(64), 1 shl 32(64) = 1 instead of 0
  1047. // use aword to prevent overflow with 1 shl 31
  1048. if (stopbit-sreg.startbit<>AIntBits) then
  1049. bitmask:=(aword(1) shl (stopbit-sreg.startbit))-1
  1050. else
  1051. bitmask:=high(aword);
  1052. a_op_const_reg(list,OP_AND,subsetregdef,tcgint(bitmask),tmpreg);
  1053. end;
  1054. subsetsizereg:=getintregister(list,subsetsize);
  1055. a_load_reg_reg(list,subsetregdef,subsetsize,tmpreg,subsetsizereg);
  1056. a_load_reg_reg(list,subsetsize,tosize,subsetsizereg,destreg);
  1057. end;
  1058. procedure thlcgobj.a_load_reg_subsetreg(list: TAsmList; fromsize, tosubsetsize: tdef; fromreg: tregister; const sreg: tsubsetregister);
  1059. begin
  1060. a_load_regconst_subsetreg_intern(list,fromsize,tosubsetsize,fromreg,sreg,SL_REG);
  1061. end;
  1062. procedure thlcgobj.a_load_subsetreg_subsetreg(list: TAsmlist; fromsubsetsize, tosubsetsize: tdef; const fromsreg, tosreg: tsubsetregister);
  1063. var
  1064. fromsubsetregdef,
  1065. tosubsetregdef: torddef;
  1066. tmpreg, tmpreg2: tregister;
  1067. bitmask: aword;
  1068. stopbit: byte;
  1069. begin
  1070. if (fromsreg.bitlen>=tosreg.bitlen) then
  1071. begin
  1072. fromsubsetregdef:=cgsize_orddef(fromsreg.subsetregsize);
  1073. tosubsetregdef:=cgsize_orddef(tosreg.subsetregsize);
  1074. if (fromsreg.startbit<=tosreg.startbit) then
  1075. begin
  1076. { tosreg may be larger -> use its size to perform the shift }
  1077. tmpreg:=getintregister(list,tosubsetregdef);
  1078. a_load_reg_reg(list,fromsubsetregdef,tosubsetregdef,fromsreg.subsetreg,tmpreg);
  1079. a_op_const_reg(list,OP_SHL,tosubsetregdef,tosreg.startbit-fromsreg.startbit,tmpreg)
  1080. end
  1081. else
  1082. begin
  1083. { fromsreg may be larger -> use its size to perform the shift }
  1084. tmpreg:=getintregister(list,fromsubsetregdef);
  1085. a_op_const_reg_reg(list,OP_SHR,fromsubsetregdef,fromsreg.startbit-tosreg.startbit,fromsreg.subsetreg,tmpreg);
  1086. tmpreg2:=getintregister(list,tosubsetregdef);
  1087. a_load_reg_reg(list,fromsubsetregdef,tosubsetregdef,tmpreg,tmpreg2);
  1088. tmpreg:=tmpreg2;
  1089. end;
  1090. stopbit:=tosreg.startbit + tosreg.bitlen;
  1091. // on x86(64), 1 shl 32(64) = 1 instead of 0
  1092. if (stopbit<>AIntBits) then
  1093. bitmask:=not(((aword(1) shl stopbit)-1) xor ((aword(1) shl tosreg.startbit)-1))
  1094. else
  1095. bitmask:=(aword(1) shl tosreg.startbit) - 1;
  1096. a_op_const_reg(list,OP_AND,tosubsetregdef,tcgint(bitmask),tosreg.subsetreg);
  1097. a_op_const_reg(list,OP_AND,tosubsetregdef,tcgint(not(bitmask)),tmpreg);
  1098. a_op_reg_reg(list,OP_OR,tosubsetregdef,tmpreg,tosreg.subsetreg);
  1099. end
  1100. else
  1101. begin
  1102. tmpreg:=getintregister(list,tosubsetsize);
  1103. a_load_subsetreg_reg(list,fromsubsetsize,tosubsetsize,fromsreg,tmpreg);
  1104. a_load_reg_subsetreg(list,tosubsetsize,tosubsetsize,tmpreg,tosreg);
  1105. end;
  1106. end;
  1107. procedure thlcgobj.a_load_subsetreg_ref(list: TAsmList; fromsubsetsize, tosize: tdef; const sreg: tsubsetregister; const destref: treference);
  1108. var
  1109. tmpreg: tregister;
  1110. begin
  1111. tmpreg:=getintregister(list,tosize);
  1112. a_load_subsetreg_reg(list,fromsubsetsize,tosize,sreg,tmpreg);
  1113. a_load_reg_ref(list,tosize,tosize,tmpreg,destref);
  1114. end;
  1115. procedure thlcgobj.a_load_ref_subsetreg(list: TAsmList; fromsize, tosubsetsize: tdef; const fromref: treference; const sreg: tsubsetregister);
  1116. var
  1117. tmpreg: tregister;
  1118. begin
  1119. tmpreg := getintregister(list,tosubsetsize);
  1120. a_load_ref_reg(list,fromsize,tosubsetsize,fromref,tmpreg);
  1121. a_load_reg_subsetreg(list,tosubsetsize,tosubsetsize,tmpreg,sreg);
  1122. end;
  1123. procedure thlcgobj.a_load_const_subsetreg(list: TAsmlist; tosubsetsize: tdef; a: tcgint; const sreg: tsubsetregister);
  1124. var
  1125. subsetregdef: torddef;
  1126. bitmask: aword;
  1127. stopbit: byte;
  1128. begin
  1129. subsetregdef:=cgsize_orddef(sreg.subsetregsize);
  1130. stopbit:=sreg.startbit+sreg.bitlen;
  1131. // on x86(64), 1 shl 32(64) = 1 instead of 0
  1132. if (stopbit<>AIntBits) then
  1133. bitmask:=not(((aword(1) shl stopbit)-1) xor ((aword(1) shl sreg.startbit)-1))
  1134. else
  1135. bitmask:=(aword(1) shl sreg.startbit)-1;
  1136. if (((aword(a) shl sreg.startbit) and not bitmask)<>not bitmask) then
  1137. a_op_const_reg(list,OP_AND,subsetregdef,tcgint(bitmask),sreg.subsetreg);
  1138. a_op_const_reg(list,OP_OR,subsetregdef,tcgint((aword(a) shl sreg.startbit) and not(bitmask)),sreg.subsetreg);
  1139. end;
  1140. procedure thlcgobj.a_load_subsetreg_loc(list: TAsmlist; fromsubsetsize, tosize: tdef; const sreg: tsubsetregister; const loc: tlocation);
  1141. begin
  1142. case loc.loc of
  1143. LOC_REFERENCE,LOC_CREFERENCE:
  1144. a_load_subsetreg_ref(list,fromsubsetsize,tosize,sreg,loc.reference);
  1145. LOC_REGISTER,LOC_CREGISTER:
  1146. a_load_subsetreg_reg(list,fromsubsetsize,tosize,sreg,loc.register);
  1147. LOC_SUBSETREG,LOC_CSUBSETREG:
  1148. a_load_subsetreg_subsetreg(list,fromsubsetsize,tosize,sreg,loc.sreg);
  1149. LOC_SUBSETREF,LOC_CSUBSETREF:
  1150. a_load_subsetreg_subsetref(list,fromsubsetsize,tosize,sreg,loc.sref);
  1151. else
  1152. internalerror(2010120406);
  1153. end;
  1154. end;
  1155. procedure thlcgobj.a_load_subsetref_reg(list: TAsmList; fromsubsetsize, tosize: tdef; const sref: tsubsetreference; destreg: tregister);
  1156. var
  1157. tmpref: treference;
  1158. valuereg,extra_value_reg: tregister;
  1159. tosreg: tsubsetregister;
  1160. loadsize: torddef;
  1161. loadbitsize: byte;
  1162. extra_load: boolean;
  1163. begin
  1164. get_subsetref_load_info(sref,loadsize,extra_load);
  1165. loadbitsize:=loadsize.size*8;
  1166. { load the (first part) of the bit sequence }
  1167. valuereg:=getintregister(list,osuinttype);
  1168. a_load_ref_reg(list,loadsize,osuinttype,sref.ref,valuereg);
  1169. if not extra_load then
  1170. begin
  1171. { everything is guaranteed to be in a single register of loadsize }
  1172. if (sref.bitindexreg=NR_NO) then
  1173. begin
  1174. { use subsetreg routine, it may have been overridden with an optimized version }
  1175. tosreg.subsetreg:=valuereg;
  1176. tosreg.subsetregsize:=def_cgsize(osuinttype);
  1177. { subsetregs always count bits from right to left }
  1178. if (target_info.endian=endian_big) then
  1179. tosreg.startbit:=loadbitsize-(sref.startbit+sref.bitlen)
  1180. else
  1181. tosreg.startbit:=sref.startbit;
  1182. tosreg.bitlen:=sref.bitlen;
  1183. a_load_subsetreg_reg(list,fromsubsetsize,tosize,tosreg,destreg);
  1184. exit;
  1185. end
  1186. else
  1187. begin
  1188. if (sref.startbit<>0) then
  1189. internalerror(2006081510);
  1190. if (target_info.endian=endian_big) then
  1191. begin
  1192. a_op_reg_reg(list,OP_SHL,osuinttype,sref.bitindexreg,valuereg);
  1193. if is_signed(fromsubsetsize) then
  1194. begin
  1195. { sign extend to entire register }
  1196. a_op_const_reg(list,OP_SHL,osuinttype,AIntBits-loadbitsize,valuereg);
  1197. a_op_const_reg(list,OP_SAR,osuinttype,AIntBits-sref.bitlen,valuereg);
  1198. end
  1199. else
  1200. a_op_const_reg(list,OP_SHR,osuinttype,loadbitsize-sref.bitlen,valuereg);
  1201. end
  1202. else
  1203. begin
  1204. a_op_reg_reg(list,OP_SHR,osuinttype,sref.bitindexreg,valuereg);
  1205. if is_signed(fromsubsetsize) then
  1206. begin
  1207. a_op_const_reg(list,OP_SHL,osuinttype,AIntBits-sref.bitlen,valuereg);
  1208. a_op_const_reg(list,OP_SAR,osuinttype,AIntBits-sref.bitlen,valuereg);
  1209. end
  1210. end;
  1211. { mask other bits/sign extend }
  1212. if not is_signed(fromsubsetsize) then
  1213. a_op_const_reg(list,OP_AND,osuinttype,tcgint((aword(1) shl sref.bitlen)-1),valuereg);
  1214. end
  1215. end
  1216. else
  1217. begin
  1218. { load next value as well }
  1219. extra_value_reg:=getintregister(list,osuinttype);
  1220. if (sref.bitindexreg=NR_NO) then
  1221. begin
  1222. tmpref:=sref.ref;
  1223. inc(tmpref.offset,loadbitsize div 8);
  1224. a_load_ref_reg(list,loadsize,osuinttype,tmpref,extra_value_reg);
  1225. { can be overridden to optimize }
  1226. a_load_subsetref_regs_noindex(list,fromsubsetsize,loadbitsize,sref,valuereg,extra_value_reg)
  1227. end
  1228. else
  1229. begin
  1230. if (sref.startbit<>0) then
  1231. internalerror(2006080610);
  1232. a_load_subsetref_regs_index(list,fromsubsetsize,loadbitsize,sref,valuereg);
  1233. end;
  1234. end;
  1235. { store in destination }
  1236. {$ifndef cpuhighleveltarget}
  1237. { avoid unnecessary sign extension and zeroing }
  1238. valuereg:=cg.makeregsize(list,valuereg,OS_INT);
  1239. destreg:=cg.makeregsize(list,destreg,OS_INT);
  1240. cg.a_load_reg_reg(list,OS_INT,OS_INT,valuereg,destreg);
  1241. destreg:=cg.makeregsize(list,destreg,def_cgsize(tosize));
  1242. {$else}
  1243. { can't juggle with register sizes, they are actually typed entities
  1244. here }
  1245. a_load_reg_reg(list,osuinttype,tosize,valuereg,destreg);
  1246. {$endif}
  1247. end;
  1248. procedure thlcgobj.a_load_reg_subsetref(list: TAsmList; fromsize, tosubsetsize: tdef; fromreg: tregister; const sref: tsubsetreference);
  1249. begin
  1250. a_load_regconst_subsetref_intern(list,fromsize,tosubsetsize,fromreg,sref,SL_REG);
  1251. end;
  1252. procedure thlcgobj.a_load_subsetref_subsetref(list: TAsmlist; fromsubsetsize, tosubsetsize: tdef; const fromsref, tosref: tsubsetreference);
  1253. var
  1254. tmpreg: tregister;
  1255. begin
  1256. tmpreg:=getintregister(list,tosubsetsize);
  1257. a_load_subsetref_reg(list,fromsubsetsize,tosubsetsize,fromsref,tmpreg);
  1258. a_load_reg_subsetref(list,tosubsetsize,tosubsetsize,tmpreg,tosref);
  1259. end;
  1260. procedure thlcgobj.a_load_subsetref_ref(list: TAsmList; fromsubsetsize, tosize: tdef; const sref: tsubsetreference; const destref: treference);
  1261. var
  1262. tmpreg: tregister;
  1263. begin
  1264. tmpreg:=getintregister(list,tosize);
  1265. a_load_subsetref_reg(list,fromsubsetsize,tosize,sref,tmpreg);
  1266. a_load_reg_ref(list,tosize,tosize,tmpreg,destref);
  1267. end;
  1268. procedure thlcgobj.a_load_ref_subsetref(list: TAsmList; fromsize, tosubsetsize: tdef; const fromref: treference; const sref: tsubsetreference);
  1269. var
  1270. tmpreg: tregister;
  1271. begin
  1272. tmpreg := getintregister(list,tosubsetsize);
  1273. a_load_ref_reg(list,fromsize,tosubsetsize,fromref,tmpreg);
  1274. a_load_reg_subsetref(list,tosubsetsize,tosubsetsize,tmpreg,sref);
  1275. end;
  1276. procedure thlcgobj.a_load_const_subsetref(list: TAsmlist; tosubsetsize: tdef; a: tcgint; const sref: tsubsetreference);
  1277. var
  1278. tmpreg: tregister;
  1279. slopt: tsubsetloadopt;
  1280. begin
  1281. { perform masking of the source value in advance }
  1282. slopt:=SL_REGNOSRCMASK;
  1283. if (sref.bitlen<>AIntBits) then
  1284. a:=tcgint(aword(a) and ((aword(1) shl sref.bitlen) -1));
  1285. if (
  1286. { broken x86 "x shl regbitsize = x" }
  1287. ((sref.bitlen<>AIntBits) and
  1288. ((aword(a) and ((aword(1) shl sref.bitlen)-1))=(aword(1) shl sref.bitlen)-1)) or
  1289. ((sref.bitlen=AIntBits) and
  1290. (a=-1))
  1291. ) then
  1292. slopt:=SL_SETMAX
  1293. else if (a=0) then
  1294. slopt:=SL_SETZERO;
  1295. if not(slopt in [SL_SETZERO,SL_SETMAX]) then
  1296. begin
  1297. tmpreg:=getintregister(list,tosubsetsize);
  1298. a_load_const_reg(list,tosubsetsize,a,tmpreg);
  1299. end
  1300. else
  1301. tmpreg:=NR_NO;
  1302. a_load_regconst_subsetref_intern(list,tosubsetsize,tosubsetsize,tmpreg,sref,slopt);
  1303. end;
  1304. procedure thlcgobj.a_load_subsetref_loc(list: TAsmlist; fromsubsetsize, tosize: tdef; const sref: tsubsetreference; const loc: tlocation);
  1305. begin
  1306. case loc.loc of
  1307. LOC_REFERENCE,LOC_CREFERENCE:
  1308. a_load_subsetref_ref(list,fromsubsetsize,tosize,sref,loc.reference);
  1309. LOC_REGISTER,LOC_CREGISTER:
  1310. a_load_subsetref_reg(list,fromsubsetsize,tosize,sref,loc.register);
  1311. LOC_SUBSETREG,LOC_CSUBSETREG:
  1312. a_load_subsetref_subsetreg(list,fromsubsetsize,tosize,sref,loc.sreg);
  1313. LOC_SUBSETREF,LOC_CSUBSETREF:
  1314. a_load_subsetref_subsetref(list,fromsubsetsize,tosize,sref,loc.sref);
  1315. else
  1316. internalerror(2010120407);
  1317. end;
  1318. end;
  1319. procedure thlcgobj.a_load_subsetref_subsetreg(list: TAsmlist; fromsubsetsize, tosubsetsize: tdef; const fromsref: tsubsetreference; const tosreg: tsubsetregister);
  1320. var
  1321. tmpreg: tregister;
  1322. begin
  1323. tmpreg:=getintregister(list,tosubsetsize);
  1324. a_load_subsetref_reg(list,fromsubsetsize,tosubsetsize,fromsref,tmpreg);
  1325. a_load_reg_subsetreg(list,tosubsetsize,tosubsetsize,tmpreg,tosreg);
  1326. end;
  1327. procedure thlcgobj.a_load_subsetreg_subsetref(list: TAsmlist; fromsubsetsize, tosubsetsize: tdef; const fromsreg: tsubsetregister; const tosref: tsubsetreference);
  1328. var
  1329. tmpreg: tregister;
  1330. begin
  1331. tmpreg := getintregister(list,tosubsetsize);
  1332. a_load_subsetreg_reg(list,fromsubsetsize,tosubsetsize,fromsreg,tmpreg);
  1333. a_load_reg_subsetref(list,tosubsetsize,tosubsetsize,tmpreg,tosref);
  1334. end;
  1335. procedure thlcgobj.a_bit_test_reg_reg_reg(list: TAsmList; bitnumbersize, valuesize, destsize: tdef; bitnumber, value, destreg: tregister);
  1336. var
  1337. tmpvalue: tregister;
  1338. begin
  1339. tmpvalue:=getintregister(list,valuesize);
  1340. if (target_info.endian=endian_little) then
  1341. begin
  1342. { rotate value register "bitnumber" bits to the right }
  1343. a_op_reg_reg_reg(list,OP_SHR,valuesize,bitnumber,value,tmpvalue);
  1344. { extract the bit we want }
  1345. a_op_const_reg(list,OP_AND,valuesize,1,tmpvalue);
  1346. end
  1347. else
  1348. begin
  1349. { highest (leftmost) bit = bit 0 -> shl bitnumber results in wanted }
  1350. { bit in uppermost position, then move it to the lowest position }
  1351. { "and" is not necessary since combination of shl/shr will clear }
  1352. { all other bits }
  1353. a_op_reg_reg_reg(list,OP_SHL,valuesize,bitnumber,value,tmpvalue);
  1354. a_op_const_reg(list,OP_SHR,valuesize,valuesize.size*8-1,tmpvalue);
  1355. end;
  1356. a_load_reg_reg(list,valuesize,destsize,tmpvalue,destreg);
  1357. end;
  1358. procedure thlcgobj.a_bit_test_const_ref_reg(list: TAsmList; fromsize, destsize: tdef; bitnumber: aint; const ref: treference; destreg: tregister);
  1359. begin
  1360. a_load_subsetref_reg(list,u8inttype,destsize,get_bit_const_ref_sref(bitnumber,fromsize,ref),destreg);
  1361. end;
  1362. procedure thlcgobj.a_bit_test_const_reg_reg(list: TAsmList; setregsize, destsize: tdef; bitnumber: aint; setreg, destreg: tregister);
  1363. begin
  1364. a_load_subsetreg_reg(list,setregsize,destsize,get_bit_const_reg_sreg(setregsize,bitnumber,setreg),destreg);
  1365. end;
  1366. procedure thlcgobj.a_bit_test_const_subsetreg_reg(list: TAsmList; fromsubsetsize, destsize: tdef; bitnumber: aint; const setreg: tsubsetregister; destreg: tregister);
  1367. var
  1368. tmpsreg: tsubsetregister;
  1369. begin
  1370. { the first parameter is used to calculate the bit offset in }
  1371. { case of big endian, and therefore must be the size of the }
  1372. { set and not of the whole subsetreg }
  1373. tmpsreg:=get_bit_const_reg_sreg(fromsubsetsize,bitnumber,setreg.subsetreg);
  1374. { now fix the size of the subsetreg }
  1375. tmpsreg.subsetregsize:=setreg.subsetregsize;
  1376. { correct offset of the set in the subsetreg }
  1377. inc(tmpsreg.startbit,setreg.startbit);
  1378. a_load_subsetreg_reg(list,fromsubsetsize,destsize,tmpsreg,destreg);
  1379. end;
  1380. procedure thlcgobj.a_bit_test_reg_ref_reg(list: TAsmList; bitnumbersize, refsize, destsize: tdef; bitnumber: tregister; const ref: treference; destreg: tregister);
  1381. begin
  1382. a_load_subsetref_reg(list,u8inttype,destsize,get_bit_reg_ref_sref(list,bitnumbersize,refsize,bitnumber,ref),destreg);
  1383. end;
  1384. procedure thlcgobj.a_bit_test_reg_loc_reg(list: TAsmList; bitnumbersize, locsize, destsize: tdef; bitnumber: tregister; const loc: tlocation; destreg: tregister);
  1385. var
  1386. tmpreg: tregister;
  1387. begin
  1388. case loc.loc of
  1389. LOC_REFERENCE,LOC_CREFERENCE:
  1390. a_bit_test_reg_ref_reg(list,bitnumbersize,locsize,destsize,bitnumber,loc.reference,destreg);
  1391. LOC_REGISTER,LOC_CREGISTER,
  1392. LOC_SUBSETREG,LOC_CSUBSETREG,
  1393. LOC_CONSTANT:
  1394. begin
  1395. case loc.loc of
  1396. LOC_REGISTER,LOC_CREGISTER:
  1397. tmpreg:=loc.register;
  1398. LOC_SUBSETREG,LOC_CSUBSETREG:
  1399. begin
  1400. tmpreg:=getintregister(list,locsize);
  1401. a_load_subsetreg_reg(list,locsize,locsize,loc.sreg,tmpreg);
  1402. end;
  1403. LOC_CONSTANT:
  1404. begin
  1405. tmpreg:=getintregister(list,locsize);
  1406. a_load_const_reg(list,locsize,loc.value,tmpreg);
  1407. end;
  1408. else
  1409. internalerror(2013112909);
  1410. end;
  1411. a_bit_test_reg_reg_reg(list,bitnumbersize,locsize,destsize,bitnumber,tmpreg,destreg);
  1412. end;
  1413. { LOC_SUBSETREF is not possible, because sets are not (yet) bitpacked }
  1414. else
  1415. internalerror(2010120411);
  1416. end;
  1417. end;
  1418. procedure thlcgobj.a_bit_test_const_loc_reg(list: TAsmList; locsize, destsize: tdef; bitnumber: aint; const loc: tlocation; destreg: tregister);
  1419. begin
  1420. case loc.loc of
  1421. LOC_REFERENCE,LOC_CREFERENCE:
  1422. a_bit_test_const_ref_reg(list,locsize,destsize,bitnumber,loc.reference,destreg);
  1423. LOC_REGISTER,LOC_CREGISTER:
  1424. a_bit_test_const_reg_reg(list,locsize,destsize,bitnumber,loc.register,destreg);
  1425. LOC_SUBSETREG,LOC_CSUBSETREG:
  1426. a_bit_test_const_subsetreg_reg(list,locsize,destsize,bitnumber,loc.sreg,destreg);
  1427. { LOC_SUBSETREF is not possible, because sets are not (yet) bitpacked }
  1428. else
  1429. internalerror(2010120410);
  1430. end;
  1431. end;
  1432. procedure thlcgobj.a_bit_set_reg_reg(list: TAsmList; doset: boolean; bitnumbersize, destsize: tdef; bitnumber, dest: tregister);
  1433. var
  1434. tmpvalue: tregister;
  1435. begin
  1436. tmpvalue:=getintregister(list,destsize);
  1437. if (target_info.endian=endian_little) then
  1438. begin
  1439. a_load_const_reg(list,destsize,1,tmpvalue);
  1440. { rotate bit "bitnumber" bits to the left }
  1441. a_op_reg_reg(list,OP_SHL,destsize,bitnumber,tmpvalue);
  1442. end
  1443. else
  1444. begin
  1445. { highest (leftmost) bit = bit 0 -> "$80/$8000/$80000000/ ... }
  1446. { shr bitnumber" results in correct mask }
  1447. a_load_const_reg(list,destsize,1 shl (destsize.size*8-1),tmpvalue);
  1448. a_op_reg_reg(list,OP_SHR,destsize,bitnumber,tmpvalue);
  1449. end;
  1450. { set/clear the bit we want }
  1451. if doset then
  1452. a_op_reg_reg(list,OP_OR,destsize,tmpvalue,dest)
  1453. else
  1454. begin
  1455. a_op_reg_reg(list,OP_NOT,destsize,tmpvalue,tmpvalue);
  1456. a_op_reg_reg(list,OP_AND,destsize,tmpvalue,dest)
  1457. end;
  1458. end;
  1459. procedure thlcgobj.a_bit_set_const_ref(list: TAsmList; doset: boolean; destsize: tdef; bitnumber: tcgint; const ref: treference);
  1460. begin
  1461. a_load_const_subsetref(list,u8inttype,ord(doset),get_bit_const_ref_sref(bitnumber,destsize,ref));
  1462. end;
  1463. procedure thlcgobj.a_bit_set_const_reg(list: TAsmList; doset: boolean; destsize: tdef; bitnumber: tcgint; destreg: tregister);
  1464. begin
  1465. a_load_const_subsetreg(list,u8inttype,ord(doset),get_bit_const_reg_sreg(destsize,bitnumber,destreg));
  1466. end;
  1467. procedure thlcgobj.a_bit_set_const_subsetreg(list: TAsmList; doset: boolean; destsize: tdef; bitnumber: tcgint; const destreg: tsubsetregister);
  1468. var
  1469. tmpsreg: tsubsetregister;
  1470. begin
  1471. { the first parameter is used to calculate the bit offset in }
  1472. { case of big endian, and therefore must be the size of the }
  1473. { set and not of the whole subsetreg }
  1474. tmpsreg:=get_bit_const_reg_sreg(destsize,bitnumber,destreg.subsetreg);
  1475. { now fix the size of the subsetreg }
  1476. tmpsreg.subsetregsize:=destreg.subsetregsize;
  1477. { correct offset of the set in the subsetreg }
  1478. inc(tmpsreg.startbit,destreg.startbit);
  1479. a_load_const_subsetreg(list,u8inttype,ord(doset),tmpsreg);
  1480. end;
  1481. procedure thlcgobj.a_bit_set_reg_ref(list: TAsmList; doset: boolean; fromsize, tosize: tdef; bitnumber: tregister; const ref: treference);
  1482. begin
  1483. a_load_const_subsetref(list,u8inttype,ord(doset),get_bit_reg_ref_sref(list,fromsize,tosize,bitnumber,ref));
  1484. end;
  1485. procedure thlcgobj.a_bit_set_reg_loc(list: TAsmList; doset: boolean; regsize, tosize: tdef; bitnumber: tregister; const loc: tlocation);
  1486. var
  1487. tmpreg: tregister;
  1488. begin
  1489. case loc.loc of
  1490. LOC_REFERENCE:
  1491. a_bit_set_reg_ref(list,doset,regsize,tosize,bitnumber,loc.reference);
  1492. LOC_CREGISTER:
  1493. a_bit_set_reg_reg(list,doset,regsize,tosize,bitnumber,loc.register);
  1494. { e.g. a 2-byte set in a record regvar }
  1495. LOC_CSUBSETREG:
  1496. begin
  1497. { hard to do in-place in a generic way, so operate on a copy }
  1498. tmpreg:=getintregister(list,tosize);
  1499. a_load_subsetreg_reg(list,tosize,tosize,loc.sreg,tmpreg);
  1500. a_bit_set_reg_reg(list,doset,regsize,tosize,bitnumber,tmpreg);
  1501. a_load_reg_subsetreg(list,tosize,tosize,tmpreg,loc.sreg);
  1502. end;
  1503. { LOC_SUBSETREF is not possible, because sets are not (yet) bitpacked }
  1504. else
  1505. internalerror(2010120408)
  1506. end;
  1507. end;
  1508. procedure thlcgobj.a_bit_set_const_loc(list: TAsmList; doset: boolean; tosize: tdef; bitnumber: tcgint; const loc: tlocation);
  1509. begin
  1510. case loc.loc of
  1511. LOC_REFERENCE:
  1512. a_bit_set_const_ref(list,doset,tosize,bitnumber,loc.reference);
  1513. LOC_CREGISTER:
  1514. a_bit_set_const_reg(list,doset,tosize,bitnumber,loc.register);
  1515. LOC_CSUBSETREG:
  1516. a_bit_set_const_subsetreg(list,doset,tosize,bitnumber,loc.sreg);
  1517. { LOC_SUBSETREF is not possible, because sets are not (yet) bitpacked }
  1518. else
  1519. internalerror(2010120409)
  1520. end;
  1521. end;
  1522. function thlcgobj.get_call_result_cgpara(pd: tprocdef; forceresdef: tdef): tcgpara;
  1523. begin
  1524. if not assigned(forceresdef) then
  1525. begin
  1526. pd.init_paraloc_info(callerside);
  1527. result:=pd.funcretloc[callerside];
  1528. end
  1529. else
  1530. result:=paramanager.get_funcretloc(pd,callerside,forceresdef);
  1531. end;
  1532. (*
  1533. Subsetrefs are used for (bit)packed arrays and (bit)packed records stored
  1534. in memory. They are like a regular reference, but contain an extra bit
  1535. offset (either constant -startbit- or variable -bitindexreg-, always OS_INT)
  1536. and a bit length (always constant).
  1537. Bit packed values are stored differently in memory depending on whether we
  1538. are on a big or a little endian system (compatible with at least GPC). The
  1539. size of the basic working unit is always the smallest power-of-2 byte size
  1540. which can contain the bit value (so 1..8 bits -> 1 byte, 9..16 bits -> 2
  1541. bytes, 17..32 bits -> 4 bytes etc).
  1542. On a big endian, 5-bit: values are stored like this:
  1543. 11111222 22333334 44445555 56666677 77788888
  1544. The leftmost bit of each 5-bit value corresponds to the most significant
  1545. bit.
  1546. On little endian, it goes like this:
  1547. 22211111 43333322 55554444 77666665 88888777
  1548. In this case, per byte the left-most bit is more significant than those on
  1549. the right, but the bits in the next byte are all more significant than
  1550. those in the previous byte (e.g., the 222 in the first byte are the low
  1551. three bits of that value, while the 22 in the second byte are the upper
  1552. two bits.
  1553. Big endian, 9 bit values:
  1554. 11111111 12222222 22333333 33344444 ...
  1555. Little endian, 9 bit values:
  1556. 11111111 22222221 33333322 44444333 ...
  1557. This is memory representation and the 16 bit values are byteswapped.
  1558. Similarly as in the previous case, the 2222222 string contains the lower
  1559. bits of value 2 and the 22 string contains the upper bits. Once loaded into
  1560. registers (two 16 bit registers in the current implementation, although a
  1561. single 32 bit register would be possible too, in particular if 32 bit
  1562. alignment can be guaranteed), this becomes:
  1563. 22222221 11111111 44444333 33333322 ...
  1564. (l)ow u l l u l u
  1565. The startbit/bitindex in a subsetreference always refers to
  1566. a) on big endian: the most significant bit of the value
  1567. (bits counted from left to right, both memory an registers)
  1568. b) on little endian: the least significant bit when the value
  1569. is loaded in a register (bit counted from right to left)
  1570. Although a) results in more complex code for big endian systems, it's
  1571. needed for compatibility both with GPC and with e.g. bitpacked arrays in
  1572. Apple's universal interfaces which depend on these layout differences).
  1573. Note: when changing the loadsize calculated in get_subsetref_load_info,
  1574. make sure the appropriate alignment is guaranteed, at least in case of
  1575. {$defined cpurequiresproperalignment}.
  1576. *)
  1577. procedure thlcgobj.get_subsetref_load_info(const sref: tsubsetreference; out loadsize: torddef; out extra_load: boolean);
  1578. var
  1579. intloadsize: tcgint;
  1580. begin
  1581. intloadsize:=packedbitsloadsize(sref.bitlen);
  1582. if (intloadsize=0) then
  1583. internalerror(2006081310);
  1584. if (intloadsize>sizeof(aint)) then
  1585. intloadsize:=sizeof(aint);
  1586. loadsize:=cgsize_orddef(int_cgsize(intloadsize));
  1587. if (sref.bitlen>sizeof(aint)*8) then
  1588. internalerror(2006081312);
  1589. extra_load:=
  1590. (sref.bitlen<>1) and
  1591. ((sref.bitindexreg<>NR_NO) or
  1592. (byte(sref.startbit+sref.bitlen)>byte(intloadsize*8)));
  1593. end;
  1594. procedure thlcgobj.a_load_subsetref_regs_noindex(list: TAsmList; subsetsize: tdef; loadbitsize: byte; const sref: tsubsetreference; valuereg, extra_value_reg: tregister);
  1595. var
  1596. restbits: byte;
  1597. begin
  1598. if (target_info.endian=endian_big) then
  1599. begin
  1600. { valuereg contains the upper bits, extra_value_reg the lower }
  1601. restbits:=(sref.bitlen-(loadbitsize-sref.startbit));
  1602. if is_signed(subsetsize) then
  1603. begin
  1604. { sign extend }
  1605. a_op_const_reg(list,OP_SHL,osuinttype,AIntBits-loadbitsize+sref.startbit,valuereg);
  1606. a_op_const_reg(list,OP_SAR,osuinttype,AIntBits-sref.bitlen,valuereg);
  1607. end
  1608. else
  1609. begin
  1610. a_op_const_reg(list,OP_SHL,osuinttype,restbits,valuereg);
  1611. { mask other bits }
  1612. if (sref.bitlen<>AIntBits) then
  1613. a_op_const_reg(list,OP_AND,osuinttype,tcgint((aword(1) shl sref.bitlen)-1),valuereg);
  1614. end;
  1615. a_op_const_reg(list,OP_SHR,osuinttype,loadbitsize-restbits,extra_value_reg)
  1616. end
  1617. else
  1618. begin
  1619. { valuereg contains the lower bits, extra_value_reg the upper }
  1620. a_op_const_reg(list,OP_SHR,osuinttype,sref.startbit,valuereg);
  1621. if is_signed(subsetsize) then
  1622. begin
  1623. a_op_const_reg(list,OP_SHL,osuinttype,AIntBits-sref.bitlen+loadbitsize-sref.startbit,extra_value_reg);
  1624. a_op_const_reg(list,OP_SAR,osuinttype,AIntBits-sref.bitlen,extra_value_reg);
  1625. end
  1626. else
  1627. begin
  1628. a_op_const_reg(list,OP_SHL,osuinttype,loadbitsize-sref.startbit,extra_value_reg);
  1629. { mask other bits }
  1630. if (sref.bitlen <> AIntBits) then
  1631. a_op_const_reg(list,OP_AND,osuinttype,tcgint((aword(1) shl sref.bitlen)-1),extra_value_reg);
  1632. end;
  1633. end;
  1634. { merge }
  1635. a_op_reg_reg(list,OP_OR,osuinttype,extra_value_reg,valuereg);
  1636. end;
  1637. procedure thlcgobj.a_load_subsetref_regs_index(list: TAsmList; subsetsize: tdef; loadbitsize: byte; const sref: tsubsetreference; valuereg: tregister);
  1638. var
  1639. hl: tasmlabel;
  1640. tmpref: treference;
  1641. extra_value_reg,
  1642. tmpreg: tregister;
  1643. begin
  1644. tmpreg:=getintregister(list,osuinttype);
  1645. tmpref:=sref.ref;
  1646. inc(tmpref.offset,loadbitsize div 8);
  1647. extra_value_reg:=getintregister(list,osuinttype);
  1648. if (target_info.endian=endian_big) then
  1649. begin
  1650. { since this is a dynamic index, it's possible that the value }
  1651. { is entirely in valuereg. }
  1652. { get the data in valuereg in the right place }
  1653. a_op_reg_reg(list,OP_SHL,osuinttype,sref.bitindexreg,valuereg);
  1654. if is_signed(subsetsize) then
  1655. begin
  1656. a_op_const_reg(list,OP_SHL,osuinttype,AIntBits-loadbitsize,valuereg);
  1657. a_op_const_reg(list,OP_SAR,osuinttype,AIntBits-sref.bitlen,valuereg)
  1658. end
  1659. else
  1660. begin
  1661. a_op_const_reg(list,OP_SHR,osuinttype,loadbitsize-sref.bitlen,valuereg);
  1662. if (loadbitsize<>AIntBits) then
  1663. { mask left over bits }
  1664. a_op_const_reg(list,OP_AND,osuinttype,tcgint((aword(1) shl sref.bitlen)-1),valuereg);
  1665. end;
  1666. tmpreg := getintregister(list,osuinttype);
  1667. { ensure we don't load anything past the end of the array }
  1668. current_asmdata.getjumplabel(hl);
  1669. a_cmp_const_reg_label(list,osuinttype,OC_BE,loadbitsize-sref.bitlen,sref.bitindexreg,hl);
  1670. { the bits in extra_value_reg (if any) start at the most significant bit => }
  1671. { extra_value_reg must be shr by (loadbitsize-sref.bitlen)+(loadsize-sref.bitindex) }
  1672. { => = -(sref.bitindex+(sref.bitlen-2*loadbitsize)) }
  1673. a_op_const_reg_reg(list,OP_ADD,osuinttype,sref.bitlen-2*loadbitsize,sref.bitindexreg,tmpreg);
  1674. a_op_reg_reg(list,OP_NEG,osuinttype,tmpreg,tmpreg);
  1675. { load next "loadbitsize" bits of the array }
  1676. a_load_ref_reg(list,cgsize_orddef(int_cgsize(loadbitsize div 8)),osuinttype,tmpref,extra_value_reg);
  1677. a_op_reg_reg(list,OP_SHR,osuinttype,tmpreg,extra_value_reg);
  1678. { if there are no bits in extra_value_reg, then sref.bitindex was }
  1679. { < loadsize-sref.bitlen, and therefore tmpreg will now be >= loadsize }
  1680. { => extra_value_reg is now 0 }
  1681. { merge }
  1682. a_op_reg_reg(list,OP_OR,osuinttype,extra_value_reg,valuereg);
  1683. { no need to mask, necessary masking happened earlier on }
  1684. a_label(list,hl);
  1685. end
  1686. else
  1687. begin
  1688. a_op_reg_reg(list,OP_SHR,osuinttype,sref.bitindexreg,valuereg);
  1689. { ensure we don't load anything past the end of the array }
  1690. current_asmdata.getjumplabel(hl);
  1691. a_cmp_const_reg_label(list,osuinttype,OC_BE,loadbitsize-sref.bitlen,sref.bitindexreg,hl);
  1692. { Y-x = -(Y-x) }
  1693. a_op_const_reg_reg(list,OP_SUB,osuinttype,loadbitsize,sref.bitindexreg,tmpreg);
  1694. a_op_reg_reg(list,OP_NEG,osuinttype,tmpreg,tmpreg);
  1695. { load next "loadbitsize" bits of the array }
  1696. a_load_ref_reg(list,cgsize_orddef(int_cgsize(loadbitsize div 8)),osuinttype,tmpref,extra_value_reg);
  1697. { tmpreg is in the range 1..<cpu_bitsize>-1 -> always ok }
  1698. a_op_reg_reg(list,OP_SHL,osuinttype,tmpreg,extra_value_reg);
  1699. { merge }
  1700. a_op_reg_reg(list,OP_OR,osuinttype,extra_value_reg,valuereg);
  1701. a_label(list,hl);
  1702. { sign extend or mask other bits }
  1703. if is_signed(subsetsize) then
  1704. begin
  1705. a_op_const_reg(list,OP_SHL,osuinttype,AIntBits-sref.bitlen,valuereg);
  1706. a_op_const_reg(list,OP_SAR,osuinttype,AIntBits-sref.bitlen,valuereg);
  1707. end
  1708. else
  1709. a_op_const_reg(list,OP_AND,osuinttype,tcgint((aword(1) shl sref.bitlen)-1),valuereg);
  1710. end;
  1711. end;
  1712. procedure thlcgobj.a_load_regconst_subsetref_intern(list: TAsmList; fromsize, subsetsize: tdef; fromreg: tregister; const sref: tsubsetreference; slopt: tsubsetloadopt);
  1713. var
  1714. hl: tasmlabel;
  1715. tmpreg, tmpindexreg, valuereg, extra_value_reg, maskreg: tregister;
  1716. tosreg, fromsreg: tsubsetregister;
  1717. tmpref: treference;
  1718. bitmask: aword;
  1719. loadsize: torddef;
  1720. loadbitsize: byte;
  1721. extra_load: boolean;
  1722. begin
  1723. { the register must be able to contain the requested value }
  1724. if (fromsize.size*8<sref.bitlen) then
  1725. internalerror(2006081613);
  1726. get_subsetref_load_info(sref,loadsize,extra_load);
  1727. loadbitsize:=loadsize.size*8;
  1728. { load the (first part) of the bit sequence }
  1729. valuereg:=getintregister(list,osuinttype);
  1730. a_load_ref_reg(list,loadsize,osuinttype,sref.ref,valuereg);
  1731. { constant offset of bit sequence? }
  1732. if not extra_load then
  1733. begin
  1734. if (sref.bitindexreg=NR_NO) then
  1735. begin
  1736. { use subsetreg routine, it may have been overridden with an optimized version }
  1737. tosreg.subsetreg:=valuereg;
  1738. tosreg.subsetregsize:=def_cgsize(osuinttype);
  1739. { subsetregs always count bits from right to left }
  1740. if (target_info.endian=endian_big) then
  1741. tosreg.startbit:=loadbitsize-(sref.startbit+sref.bitlen)
  1742. else
  1743. tosreg.startbit:=sref.startbit;
  1744. tosreg.bitlen:=sref.bitlen;
  1745. a_load_regconst_subsetreg_intern(list,fromsize,subsetsize,fromreg,tosreg,slopt);
  1746. end
  1747. else
  1748. begin
  1749. if (sref.startbit<>0) then
  1750. internalerror(2006081710);
  1751. { should be handled by normal code and will give wrong result }
  1752. { on x86 for the '1 shl bitlen' below }
  1753. if (sref.bitlen=AIntBits) then
  1754. internalerror(2006081711);
  1755. { zero the bits we have to insert }
  1756. if (slopt<>SL_SETMAX) then
  1757. begin
  1758. maskreg:=getintregister(list,osuinttype);
  1759. if (target_info.endian = endian_big) then
  1760. begin
  1761. a_load_const_reg(list,osuinttype,tcgint((aword(1) shl sref.bitlen)-1) shl (loadbitsize-sref.bitlen),maskreg);
  1762. a_op_reg_reg(list,OP_SHR,osuinttype,sref.bitindexreg,maskreg);
  1763. end
  1764. else
  1765. begin
  1766. a_load_const_reg(list,osuinttype,tcgint((aword(1) shl sref.bitlen)-1),maskreg);
  1767. a_op_reg_reg(list,OP_SHL,osuinttype,sref.bitindexreg,maskreg);
  1768. end;
  1769. a_op_reg_reg(list,OP_NOT,osuinttype,maskreg,maskreg);
  1770. a_op_reg_reg(list,OP_AND,osuinttype,maskreg,valuereg);
  1771. end;
  1772. { insert the value }
  1773. if (slopt<>SL_SETZERO) then
  1774. begin
  1775. tmpreg:=getintregister(list,osuinttype);
  1776. if (slopt<>SL_SETMAX) then
  1777. a_load_reg_reg(list,fromsize,osuinttype,fromreg,tmpreg)
  1778. else if (sref.bitlen<>AIntBits) then
  1779. a_load_const_reg(list,osuinttype,tcgint((aword(1) shl sref.bitlen)-1), tmpreg)
  1780. else
  1781. a_load_const_reg(list,osuinttype,-1,tmpreg);
  1782. if (target_info.endian=endian_big) then
  1783. begin
  1784. a_op_const_reg(list,OP_SHL,osuinttype,loadbitsize-sref.bitlen,tmpreg);
  1785. if not(slopt in [SL_REGNOSRCMASK,SL_SETMAX]) then
  1786. begin
  1787. if (loadbitsize<>AIntBits) then
  1788. bitmask:=(((aword(1) shl loadbitsize)-1) xor ((aword(1) shl (loadbitsize-sref.bitlen))-1))
  1789. else
  1790. bitmask:=(high(aword) xor ((aword(1) shl (loadbitsize-sref.bitlen))-1));
  1791. a_op_const_reg(list,OP_AND,osuinttype,bitmask,tmpreg);
  1792. end;
  1793. a_op_reg_reg(list,OP_SHR,osuinttype,sref.bitindexreg,tmpreg);
  1794. end
  1795. else
  1796. begin
  1797. if not(slopt in [SL_REGNOSRCMASK,SL_SETMAX]) then
  1798. a_op_const_reg(list,OP_AND,osuinttype,tcgint((aword(1) shl sref.bitlen)-1),tmpreg);
  1799. a_op_reg_reg(list,OP_SHL,osuinttype,sref.bitindexreg,tmpreg);
  1800. end;
  1801. a_op_reg_reg(list,OP_OR,osuinttype,tmpreg,valuereg);
  1802. end;
  1803. end;
  1804. { store back to memory }
  1805. tmpreg:=getintregister(list,loadsize);
  1806. a_load_reg_reg(list,osuinttype,loadsize,valuereg,tmpreg);
  1807. a_load_reg_ref(list,loadsize,loadsize,tmpreg,sref.ref);
  1808. exit;
  1809. end
  1810. else
  1811. begin
  1812. { load next value }
  1813. extra_value_reg:=getintregister(list,osuinttype);
  1814. tmpref:=sref.ref;
  1815. inc(tmpref.offset,loadbitsize div 8);
  1816. { should maybe be taken out too, can be done more efficiently }
  1817. { on e.g. i386 with shld/shrd }
  1818. if (sref.bitindexreg = NR_NO) then
  1819. begin
  1820. a_load_ref_reg(list,loadsize,osuinttype,tmpref,extra_value_reg);
  1821. fromsreg.subsetreg:=fromreg;
  1822. fromsreg.subsetregsize:=def_cgsize(fromsize);
  1823. tosreg.subsetreg:=valuereg;
  1824. tosreg.subsetregsize:=def_cgsize(osuinttype);
  1825. { transfer first part }
  1826. fromsreg.bitlen:=loadbitsize-sref.startbit;
  1827. tosreg.bitlen:=fromsreg.bitlen;
  1828. if (target_info.endian=endian_big) then
  1829. begin
  1830. { valuereg must contain the upper bits of the value at bits [0..loadbitsize-startbit] }
  1831. { upper bits of the value ... }
  1832. fromsreg.startbit:=sref.bitlen-(loadbitsize-sref.startbit);
  1833. { ... to bit 0 }
  1834. tosreg.startbit:=0
  1835. end
  1836. else
  1837. begin
  1838. { valuereg must contain the lower bits of the value at bits [startbit..loadbitsize] }
  1839. { lower bits of the value ... }
  1840. fromsreg.startbit:=0;
  1841. { ... to startbit }
  1842. tosreg.startbit:=sref.startbit;
  1843. end;
  1844. case slopt of
  1845. SL_SETZERO,
  1846. SL_SETMAX:
  1847. a_load_regconst_subsetreg_intern(list,fromsize,subsetsize,fromreg,tosreg,slopt);
  1848. else
  1849. a_load_subsetreg_subsetreg(list,subsetsize,subsetsize,fromsreg,tosreg);
  1850. end;
  1851. {$ifndef cpuhighleveltarget}
  1852. valuereg:=cg.makeregsize(list,valuereg,def_cgsize(loadsize));
  1853. a_load_reg_ref(list,loadsize,loadsize,valuereg,sref.ref);
  1854. {$else}
  1855. tmpreg:=getintregister(list,loadsize);
  1856. a_load_reg_reg(list,osuinttype,loadsize,valuereg,tmpreg);
  1857. a_load_reg_ref(list,loadsize,loadsize,tmpreg,sref.ref);
  1858. {$endif}
  1859. { transfer second part }
  1860. if (target_info.endian = endian_big) then
  1861. begin
  1862. { extra_value_reg must contain the lower bits of the value at bits }
  1863. { [(loadbitsize-(bitlen-(loadbitsize-startbit)))..loadbitsize] }
  1864. { (loadbitsize-(bitlen-(loadbitsize-startbit))) = 2*loadbitsize }
  1865. { - bitlen - startbit }
  1866. fromsreg.startbit:=0;
  1867. tosreg.startbit:=2*loadbitsize-sref.bitlen-sref.startbit
  1868. end
  1869. else
  1870. begin
  1871. { extra_value_reg must contain the upper bits of the value at bits [0..bitlen-(loadbitsize-startbit)] }
  1872. fromsreg.startbit:=fromsreg.bitlen;
  1873. tosreg.startbit:=0;
  1874. end;
  1875. tosreg.subsetreg:=extra_value_reg;
  1876. fromsreg.bitlen:=sref.bitlen-fromsreg.bitlen;
  1877. tosreg.bitlen:=fromsreg.bitlen;
  1878. case slopt of
  1879. SL_SETZERO,
  1880. SL_SETMAX:
  1881. a_load_regconst_subsetreg_intern(list,fromsize,subsetsize,fromreg,tosreg,slopt);
  1882. else
  1883. a_load_subsetreg_subsetreg(list,subsetsize,subsetsize,fromsreg,tosreg);
  1884. end;
  1885. tmpreg:=getintregister(list,loadsize);
  1886. a_load_reg_reg(list,osuinttype,loadsize,extra_value_reg,tmpreg);
  1887. a_load_reg_ref(list,loadsize,loadsize,tmpreg,tmpref);
  1888. exit;
  1889. end
  1890. else
  1891. begin
  1892. if (sref.startbit <> 0) then
  1893. internalerror(2006081812);
  1894. { should be handled by normal code and will give wrong result }
  1895. { on x86 for the '1 shl bitlen' below }
  1896. if (sref.bitlen = AIntBits) then
  1897. internalerror(2006081713);
  1898. { generate mask to zero the bits we have to insert }
  1899. if (slopt <> SL_SETMAX) then
  1900. begin
  1901. maskreg := getintregister(list,osuinttype);
  1902. if (target_info.endian = endian_big) then
  1903. begin
  1904. a_load_const_reg(list,osuinttype,tcgint(((aword(1) shl sref.bitlen)-1) shl (loadbitsize-sref.bitlen)),maskreg);
  1905. a_op_reg_reg(list,OP_SHR,osuinttype,sref.bitindexreg,maskreg);
  1906. end
  1907. else
  1908. begin
  1909. a_load_const_reg(list,osuinttype,tcgint((aword(1) shl sref.bitlen)-1),maskreg);
  1910. a_op_reg_reg(list,OP_SHL,osuinttype,sref.bitindexreg,maskreg);
  1911. end;
  1912. a_op_reg_reg(list,OP_NOT,osuinttype,maskreg,maskreg);
  1913. a_op_reg_reg(list,OP_AND,osuinttype,maskreg,valuereg);
  1914. end;
  1915. { insert the value }
  1916. if (slopt <> SL_SETZERO) then
  1917. begin
  1918. tmpreg := getintregister(list,osuinttype);
  1919. if (slopt <> SL_SETMAX) then
  1920. a_load_reg_reg(list,fromsize,osuinttype,fromreg,tmpreg)
  1921. else if (sref.bitlen <> AIntBits) then
  1922. a_load_const_reg(list,osuinttype,tcgint((aword(1) shl sref.bitlen) - 1), tmpreg)
  1923. else
  1924. a_load_const_reg(list,osuinttype,-1,tmpreg);
  1925. if (target_info.endian = endian_big) then
  1926. begin
  1927. a_op_const_reg(list,OP_SHL,osuinttype,loadbitsize-sref.bitlen,tmpreg);
  1928. if not(slopt in [SL_REGNOSRCMASK,SL_SETMAX]) then
  1929. { mask left over bits }
  1930. a_op_const_reg(list,OP_AND,osuinttype,tcgint(((aword(1) shl sref.bitlen)-1) shl (loadbitsize-sref.bitlen)),tmpreg);
  1931. a_op_reg_reg(list,OP_SHR,osuinttype,sref.bitindexreg,tmpreg);
  1932. end
  1933. else
  1934. begin
  1935. if not(slopt in [SL_REGNOSRCMASK,SL_SETMAX]) then
  1936. { mask left over bits }
  1937. a_op_const_reg(list,OP_AND,osuinttype,tcgint((aword(1) shl sref.bitlen)-1),tmpreg);
  1938. a_op_reg_reg(list,OP_SHL,osuinttype,sref.bitindexreg,tmpreg);
  1939. end;
  1940. a_op_reg_reg(list,OP_OR,osuinttype,tmpreg,valuereg);
  1941. end;
  1942. tmpreg:=getintregister(list,loadsize);
  1943. a_load_reg_reg(list,osuinttype,loadsize,valuereg,tmpreg);
  1944. a_load_reg_ref(list,loadsize,loadsize,tmpreg,sref.ref);
  1945. { make sure we do not read/write past the end of the array }
  1946. current_asmdata.getjumplabel(hl);
  1947. a_cmp_const_reg_label(list,osuinttype,OC_BE,loadbitsize-sref.bitlen,sref.bitindexreg,hl);
  1948. a_load_ref_reg(list,loadsize,osuinttype,tmpref,extra_value_reg);
  1949. tmpindexreg:=getintregister(list,osuinttype);
  1950. { load current array value }
  1951. if (slopt<>SL_SETZERO) then
  1952. begin
  1953. tmpreg:=getintregister(list,osuinttype);
  1954. if (slopt<>SL_SETMAX) then
  1955. a_load_reg_reg(list,fromsize,osuinttype,fromreg,tmpreg)
  1956. else if (sref.bitlen<>AIntBits) then
  1957. a_load_const_reg(list,osuinttype,tcgint((aword(1) shl sref.bitlen) - 1), tmpreg)
  1958. else
  1959. a_load_const_reg(list,osuinttype,-1,tmpreg);
  1960. end;
  1961. { generate mask to zero the bits we have to insert }
  1962. if (slopt<>SL_SETMAX) then
  1963. begin
  1964. maskreg:=getintregister(list,osuinttype);
  1965. if (target_info.endian=endian_big) then
  1966. begin
  1967. a_op_const_reg_reg(list,OP_ADD,osuinttype,sref.bitlen-2*loadbitsize,sref.bitindexreg,tmpindexreg);
  1968. a_op_reg_reg(list,OP_NEG,osuinttype,tmpindexreg,tmpindexreg);
  1969. a_load_const_reg(list,osuinttype,tcgint((aword(1) shl sref.bitlen)-1),maskreg);
  1970. a_op_reg_reg(list,OP_SHL,osuinttype,tmpindexreg,maskreg);
  1971. end
  1972. else
  1973. begin
  1974. { Y-x = -(x-Y) }
  1975. a_op_const_reg_reg(list,OP_SUB,osuinttype,loadbitsize,sref.bitindexreg,tmpindexreg);
  1976. a_op_reg_reg(list,OP_NEG,osuinttype,tmpindexreg,tmpindexreg);
  1977. a_load_const_reg(list,osuinttype,tcgint((aword(1) shl sref.bitlen)-1),maskreg);
  1978. a_op_reg_reg(list,OP_SHR,osuinttype,tmpindexreg,maskreg);
  1979. end;
  1980. a_op_reg_reg(list,OP_NOT,osuinttype,maskreg,maskreg);
  1981. a_op_reg_reg(list,OP_AND,osuinttype,maskreg,extra_value_reg);
  1982. end;
  1983. if (slopt<>SL_SETZERO) then
  1984. begin
  1985. if (target_info.endian=endian_big) then
  1986. a_op_reg_reg(list,OP_SHL,osuinttype,tmpindexreg,tmpreg)
  1987. else
  1988. begin
  1989. if not(slopt in [SL_REGNOSRCMASK,SL_SETMAX]) then
  1990. a_op_const_reg(list,OP_AND,osuinttype,tcgint((aword(1) shl sref.bitlen)-1),tmpreg);
  1991. a_op_reg_reg(list,OP_SHR,osuinttype,tmpindexreg,tmpreg);
  1992. end;
  1993. a_op_reg_reg(list,OP_OR,osuinttype,tmpreg,extra_value_reg);
  1994. end;
  1995. {$ifndef cpuhighleveltarget}
  1996. extra_value_reg:=cg.makeregsize(list,extra_value_reg,def_cgsize(loadsize));
  1997. a_load_reg_ref(list,loadsize,loadsize,extra_value_reg,tmpref);
  1998. {$else}
  1999. tmpreg:=getintregister(list,loadsize);
  2000. a_load_reg_reg(list,osuinttype,loadsize,extra_value_reg,tmpreg);
  2001. a_load_reg_ref(list,loadsize,loadsize,tmpreg,tmpref);
  2002. {$endif}
  2003. a_label(list,hl);
  2004. end;
  2005. end;
  2006. end;
  2007. procedure thlcgobj.a_load_regconst_subsetreg_intern(list: TAsmList; fromsize, subsetsize: tdef; fromreg: tregister; const sreg: tsubsetregister; slopt: tsubsetloadopt);
  2008. var
  2009. bitmask: aword;
  2010. tmpreg: tregister;
  2011. subsetregdef: torddef;
  2012. stopbit: byte;
  2013. begin
  2014. tmpreg:=NR_NO;
  2015. subsetregdef:=cgsize_orddef(sreg.subsetregsize);
  2016. stopbit:=sreg.startbit+sreg.bitlen;
  2017. // on x86(64), 1 shl 32(64) = 1 instead of 0
  2018. if (stopbit<>AIntBits) then
  2019. bitmask:=not(((aword(1) shl stopbit)-1) xor ((aword(1) shl sreg.startbit)-1))
  2020. else
  2021. bitmask:=not(high(aword) xor ((aword(1) shl sreg.startbit)-1));
  2022. if not(slopt in [SL_SETZERO,SL_SETMAX]) then
  2023. begin
  2024. tmpreg:=getintregister(list,subsetregdef);
  2025. a_load_reg_reg(list,fromsize,subsetregdef,fromreg,tmpreg);
  2026. a_op_const_reg(list,OP_SHL,subsetregdef,sreg.startbit,tmpreg);
  2027. if (slopt<>SL_REGNOSRCMASK) then
  2028. a_op_const_reg(list,OP_AND,subsetregdef,tcgint(not(bitmask)),tmpreg);
  2029. end;
  2030. if (slopt<>SL_SETMAX) and
  2031. { the "and" is not needed if the whole register is modified (except for SL_SETZERO),
  2032. because later on we do a move in this case instead of an or }
  2033. ((sreg.bitlen<>AIntBits) or (slopt=SL_SETZERO)) then
  2034. a_op_const_reg(list,OP_AND,subsetregdef,tcgint(bitmask),sreg.subsetreg);
  2035. case slopt of
  2036. SL_SETZERO : ;
  2037. SL_SETMAX :
  2038. if (sreg.bitlen<>AIntBits) then
  2039. a_op_const_reg(list,OP_OR,subsetregdef,
  2040. tcgint(((aword(1) shl sreg.bitlen)-1) shl sreg.startbit),
  2041. sreg.subsetreg)
  2042. else
  2043. a_load_const_reg(list,subsetregdef,-1,sreg.subsetreg);
  2044. { if the whole register is modified, no "or" is needed }
  2045. else if sreg.bitlen=AIntBits then
  2046. a_load_reg_reg(list,subsetregdef,subsetregdef,tmpreg,sreg.subsetreg)
  2047. else
  2048. a_op_reg_reg(list,OP_OR,subsetregdef,tmpreg,sreg.subsetreg)
  2049. end;
  2050. end;
  2051. {$pop}
  2052. function thlcgobj.get_bit_const_ref_sref(bitnumber: tcgint; refdef: tdef; const ref: treference): tsubsetreference;
  2053. begin
  2054. result.ref:=ref;
  2055. inc(result.ref.offset,bitnumber div 8);
  2056. result.bitindexreg:=NR_NO;
  2057. result.startbit:=bitnumber mod 8;
  2058. result.bitlen:=1;
  2059. end;
  2060. function thlcgobj.get_bit_const_reg_sreg(setregsize: tdef; bitnumber: tcgint; setreg: tregister): tsubsetregister;
  2061. begin
  2062. result.subsetreg:=setreg;
  2063. result.subsetregsize:=def_cgsize(setregsize);
  2064. { subsetregs always count from the least significant to the most significant bit }
  2065. if (target_info.endian=endian_big) then
  2066. result.startbit:=(setregsize.size*8)-bitnumber-1
  2067. else
  2068. result.startbit:=bitnumber;
  2069. result.bitlen:=1;
  2070. end;
  2071. function thlcgobj.get_bit_reg_ref_sref(list: TAsmList; bitnumbersize, refsize: tdef; bitnumber: tregister; const ref: treference): tsubsetreference;
  2072. var
  2073. tmpreg: tregister;
  2074. begin
  2075. result.ref:=ref;
  2076. result.startbit:=0;
  2077. result.bitlen:=1;
  2078. tmpreg:=getintregister(list,ptruinttype);
  2079. a_load_reg_reg(list,bitnumbersize,ptruinttype,bitnumber,tmpreg);
  2080. a_op_const_reg(list,OP_SHR,ptruinttype,3,tmpreg);
  2081. { don't assign to ref.base, that one is for pointers and this is an index
  2082. (important for platforms like LLVM) }
  2083. if (result.ref.index=NR_NO) then
  2084. result.ref.index:=tmpreg
  2085. else
  2086. begin
  2087. a_op_reg_reg(list,OP_ADD,ptruinttype,result.ref.index,tmpreg);
  2088. result.ref.index:=tmpreg;
  2089. end;
  2090. tmpreg:=getintregister(list,ptruinttype);
  2091. a_load_reg_reg(list,bitnumbersize,ptruinttype,bitnumber,tmpreg);
  2092. a_op_const_reg(list,OP_AND,ptruinttype,7,tmpreg);
  2093. result.bitindexreg:=tmpreg;
  2094. end;
  2095. procedure thlcgobj.a_loadfpu_ref_ref(list: TAsmList; fromsize, tosize: tdef; const ref1, ref2: treference);
  2096. var
  2097. reg: tregister;
  2098. regsize: tdef;
  2099. begin
  2100. if (fromsize.size>=tosize.size) then
  2101. regsize:=fromsize
  2102. else
  2103. regsize:=tosize;
  2104. reg:=getfpuregister(list,regsize);
  2105. a_loadfpu_ref_reg(list,fromsize,regsize,ref1,reg);
  2106. a_loadfpu_reg_ref(list,regsize,tosize,reg,ref2);
  2107. end;
  2108. procedure thlcgobj.a_loadfpu_loc_reg(list: TAsmList; fromsize, tosize: tdef; const loc: tlocation; const reg: tregister);
  2109. begin
  2110. case loc.loc of
  2111. LOC_REFERENCE, LOC_CREFERENCE:
  2112. a_loadfpu_ref_reg(list,fromsize,tosize,loc.reference,reg);
  2113. LOC_FPUREGISTER, LOC_CFPUREGISTER:
  2114. a_loadfpu_reg_reg(list,fromsize,tosize,loc.register,reg);
  2115. else
  2116. internalerror(2010120412);
  2117. end;
  2118. end;
  2119. procedure thlcgobj.a_loadfpu_reg_loc(list: TAsmList; fromsize, tosize: tdef; const reg: tregister; const loc: tlocation);
  2120. begin
  2121. case loc.loc of
  2122. LOC_REFERENCE, LOC_CREFERENCE:
  2123. a_loadfpu_reg_ref(list,fromsize,tosize,reg,loc.reference);
  2124. LOC_FPUREGISTER, LOC_CFPUREGISTER:
  2125. a_loadfpu_reg_reg(list,fromsize,tosize,reg,loc.register);
  2126. else
  2127. internalerror(2010120413);
  2128. end;
  2129. end;
  2130. procedure thlcgobj.a_loadfpu_reg_cgpara(list: TAsmList; fromsize: tdef; const r: tregister; const cgpara: TCGPara);
  2131. var
  2132. ref : treference;
  2133. begin
  2134. paramanager.alloccgpara(list,cgpara);
  2135. case cgpara.location^.loc of
  2136. LOC_FPUREGISTER,LOC_CFPUREGISTER:
  2137. begin
  2138. cgpara.check_simple_location;
  2139. a_loadfpu_reg_reg(list,fromsize,cgpara.def,r,cgpara.location^.register);
  2140. end;
  2141. LOC_REFERENCE,LOC_CREFERENCE:
  2142. begin
  2143. cgpara.check_simple_location;
  2144. reference_reset_base(ref,voidstackpointertype,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment);
  2145. a_loadfpu_reg_ref(list,fromsize,cgpara.def,r,ref);
  2146. end;
  2147. LOC_REGISTER,LOC_CREGISTER:
  2148. begin
  2149. { paramfpu_ref does the check_simpe_location check here if necessary }
  2150. tg.gethltemp(list,fromsize,fromsize.size,tt_normal,ref);
  2151. a_loadfpu_reg_ref(list,fromsize,fromsize,r,ref);
  2152. a_loadfpu_ref_cgpara(list,fromsize,ref,cgpara);
  2153. tg.Ungettemp(list,ref);
  2154. end;
  2155. else
  2156. internalerror(2010120422);
  2157. end;
  2158. end;
  2159. procedure thlcgobj.a_loadfpu_ref_cgpara(list: TAsmList; fromsize: tdef; const ref: treference; const cgpara: TCGPara);
  2160. var
  2161. href : treference;
  2162. // hsize: tcgsize;
  2163. begin
  2164. case cgpara.location^.loc of
  2165. LOC_FPUREGISTER,LOC_CFPUREGISTER:
  2166. begin
  2167. cgpara.check_simple_location;
  2168. paramanager.alloccgpara(list,cgpara);
  2169. a_loadfpu_ref_reg(list,fromsize,cgpara.def,ref,cgpara.location^.register);
  2170. end;
  2171. LOC_REFERENCE,LOC_CREFERENCE:
  2172. begin
  2173. cgpara.check_simple_location;
  2174. reference_reset_base(href,voidstackpointertype,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment);
  2175. { concatcopy should choose the best way to copy the data }
  2176. g_concatcopy(list,fromsize,ref,href);
  2177. end;
  2178. (* not yet supported
  2179. LOC_REGISTER,LOC_CREGISTER:
  2180. begin
  2181. { force integer size }
  2182. hsize:=int_cgsize(tcgsize2size[size]);
  2183. {$ifndef cpu64bitalu}
  2184. if (hsize in [OS_S64,OS_64]) then
  2185. cg64.a_load64_ref_cgpara(list,ref,cgpara)
  2186. else
  2187. {$endif not cpu64bitalu}
  2188. begin
  2189. cgpara.check_simple_location;
  2190. a_load_ref_cgpara(list,hsize,ref,cgpara)
  2191. end;
  2192. end
  2193. *)
  2194. else
  2195. internalerror(2010120423);
  2196. end;
  2197. end;
  2198. procedure thlcgobj.a_loadmm_ref_ref(list: TAsmList; fromsize, tosize: tdef; const fromref, toref: treference; shuffle: pmmshuffle);
  2199. var
  2200. reg: tregister;
  2201. begin
  2202. reg:=getmmregister(list,tosize);
  2203. a_loadmm_ref_reg(list,fromsize,tosize,fromref,reg,shuffle);
  2204. a_loadmm_reg_ref(list,tosize,tosize,reg,toref,shuffle);
  2205. end;
  2206. procedure thlcgobj.a_loadmm_loc_reg(list: TAsmList; fromsize, tosize: tdef; const loc: tlocation; const reg: tregister; shuffle: pmmshuffle);
  2207. var
  2208. tmpreg: tregister;
  2209. begin
  2210. case loc.loc of
  2211. LOC_MMREGISTER,LOC_CMMREGISTER:
  2212. a_loadmm_reg_reg(list,fromsize,tosize,loc.register,reg,shuffle);
  2213. LOC_REFERENCE,LOC_CREFERENCE:
  2214. a_loadmm_ref_reg(list,fromsize,tosize,loc.reference,reg,shuffle);
  2215. LOC_REGISTER,LOC_CREGISTER:
  2216. a_loadmm_intreg_reg(list,fromsize,tosize,loc.register,reg,shuffle);
  2217. LOC_SUBSETREG,LOC_CSUBSETREG,
  2218. LOC_SUBSETREF,LOC_CSUBSETREF:
  2219. begin
  2220. tmpreg:=getintregister(list,fromsize);
  2221. a_load_loc_reg(list,fromsize,fromsize,loc,tmpreg);
  2222. a_loadmm_intreg_reg(list,fromsize,tosize,tmpreg,reg,shuffle);
  2223. end
  2224. else
  2225. internalerror(2010120414);
  2226. end;
  2227. end;
  2228. procedure thlcgobj.a_loadmm_reg_loc(list: TAsmList; fromsize, tosize: tdef; const reg: tregister; const loc: tlocation; shuffle: pmmshuffle);
  2229. begin
  2230. case loc.loc of
  2231. LOC_MMREGISTER,LOC_CMMREGISTER:
  2232. a_loadmm_reg_reg(list,fromsize,tosize,reg,loc.register,shuffle);
  2233. LOC_REFERENCE,LOC_CREFERENCE:
  2234. a_loadmm_reg_ref(list,fromsize,tosize,reg,loc.reference,shuffle);
  2235. else
  2236. internalerror(2010120415);
  2237. end;
  2238. end;
  2239. procedure thlcgobj.a_loadmm_reg_cgpara(list: TAsmList; fromsize: tdef; reg: tregister; const cgpara: TCGPara; shuffle: pmmshuffle);
  2240. var
  2241. href : treference;
  2242. begin
  2243. cgpara.check_simple_location;
  2244. paramanager.alloccgpara(list,cgpara);
  2245. case cgpara.location^.loc of
  2246. LOC_MMREGISTER,LOC_CMMREGISTER:
  2247. a_loadmm_reg_reg(list,fromsize,cgpara.def,reg,cgpara.location^.register,shuffle);
  2248. LOC_REFERENCE,LOC_CREFERENCE:
  2249. begin
  2250. reference_reset_base(href,voidstackpointertype,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment);
  2251. a_loadmm_reg_ref(list,fromsize,cgpara.def,reg,href,shuffle);
  2252. end;
  2253. LOC_REGISTER,LOC_CREGISTER:
  2254. begin
  2255. if assigned(shuffle) and
  2256. not shufflescalar(shuffle) then
  2257. internalerror(2012071205);
  2258. a_loadmm_reg_intreg(list,fromsize,cgpara.def,reg,cgpara.location^.register,mms_movescalar);
  2259. end
  2260. else
  2261. internalerror(2012071204);
  2262. end;
  2263. end;
  2264. procedure thlcgobj.a_loadmm_ref_cgpara(list: TAsmList; fromsize: tdef; const ref: treference; const cgpara: TCGPara; shuffle: pmmshuffle);
  2265. var
  2266. hr : tregister;
  2267. hs : tmmshuffle;
  2268. begin
  2269. cgpara.check_simple_location;
  2270. hr:=getmmregister(list,cgpara.def);
  2271. a_loadmm_ref_reg(list,fromsize,cgpara.def,ref,hr,shuffle);
  2272. if realshuffle(shuffle) then
  2273. begin
  2274. hs:=shuffle^;
  2275. removeshuffles(hs);
  2276. a_loadmm_reg_cgpara(list,cgpara.def,hr,cgpara,@hs);
  2277. end
  2278. else
  2279. a_loadmm_reg_cgpara(list,cgpara.def,hr,cgpara,shuffle);
  2280. end;
  2281. procedure thlcgobj.a_loadmm_loc_cgpara(list: TAsmList; fromsize: tdef; const loc: tlocation; const cgpara: TCGPara; shuffle: pmmshuffle);
  2282. begin
  2283. {$ifdef extdebug}
  2284. if def_cgsize(fromsize)<>loc.size then
  2285. internalerror(2012071203);
  2286. {$endif}
  2287. case loc.loc of
  2288. LOC_MMREGISTER,LOC_CMMREGISTER:
  2289. a_loadmm_reg_cgpara(list,fromsize,loc.register,cgpara,shuffle);
  2290. LOC_REFERENCE,LOC_CREFERENCE:
  2291. a_loadmm_ref_cgpara(list,fromsize,loc.reference,cgpara,shuffle);
  2292. else
  2293. internalerror(2012071202);
  2294. end;
  2295. end;
  2296. procedure thlcgobj.a_opmm_ref_reg(list: TAsmList; Op: TOpCG; size: tdef; const ref: treference; reg: tregister; shuffle: pmmshuffle);
  2297. var
  2298. hr : tregister;
  2299. hs : tmmshuffle;
  2300. begin
  2301. hr:=getmmregister(list,size);
  2302. a_loadmm_ref_reg(list,size,size,ref,hr,shuffle);
  2303. if realshuffle(shuffle) then
  2304. begin
  2305. hs:=shuffle^;
  2306. removeshuffles(hs);
  2307. a_opmm_reg_reg(list,op,size,hr,reg,@hs);
  2308. end
  2309. else
  2310. a_opmm_reg_reg(list,op,size,hr,reg,shuffle);
  2311. end;
  2312. procedure thlcgobj.a_opmm_loc_reg(list: TAsmList; Op: TOpCG; size: tdef; const loc: tlocation; reg: tregister; shuffle: pmmshuffle);
  2313. begin
  2314. case loc.loc of
  2315. LOC_CMMREGISTER,LOC_MMREGISTER:
  2316. a_opmm_reg_reg(list,op,size,loc.register,reg,shuffle);
  2317. LOC_CREFERENCE,LOC_REFERENCE:
  2318. a_opmm_ref_reg(list,op,size,loc.reference,reg,shuffle);
  2319. else
  2320. internalerror(2012071201);
  2321. end;
  2322. end;
  2323. procedure thlcgobj.a_opmm_reg_ref(list: TAsmList; Op: TOpCG; size: tdef; reg: tregister; const ref: treference; shuffle: pmmshuffle);
  2324. var
  2325. hr : tregister;
  2326. hs : tmmshuffle;
  2327. begin
  2328. hr:=getmmregister(list,size);
  2329. a_loadmm_ref_reg(list,size,size,ref,hr,shuffle);
  2330. if realshuffle(shuffle) then
  2331. begin
  2332. hs:=shuffle^;
  2333. removeshuffles(hs);
  2334. a_opmm_reg_reg(list,op,size,reg,hr,@hs);
  2335. a_loadmm_reg_ref(list,size,size,hr,ref,@hs);
  2336. end
  2337. else
  2338. begin
  2339. a_opmm_reg_reg(list,op,size,reg,hr,shuffle);
  2340. a_loadmm_reg_ref(list,size,size,hr,ref,shuffle);
  2341. end;
  2342. end;
  2343. (*
  2344. procedure thlcgobj.a_loadmm_intreg_reg(list: TAsmList; fromsize, tosize: tdef; intreg, mmreg: tregister; shuffle: pmmshuffle);
  2345. begin
  2346. cg.a_loadmm_intreg_reg(list,def_cgsize(fromsize),def_cgsize(tosize),intreg,mmreg,shuffle);
  2347. end;
  2348. procedure thlcgobj.a_loadmm_reg_intreg(list: TAsmList; fromsize, tosize: tdef; mmreg, intreg: tregister; shuffle: pmmshuffle);
  2349. begin
  2350. cg.a_loadmm_reg_intreg(list,def_cgsize(fromsize),def_cgsize(tosize),mmreg,intreg,shuffle);
  2351. end;
  2352. *)
  2353. procedure thlcgobj.a_op_const_ref(list: TAsmList; Op: TOpCG; size: tdef; a: tcgint; const ref: TReference);
  2354. var
  2355. tmpreg : tregister;
  2356. begin
  2357. tmpreg:=getintregister(list,size);
  2358. a_load_ref_reg(list,size,size,ref,tmpreg);
  2359. a_op_const_reg(list,op,size,a,tmpreg);
  2360. a_load_reg_ref(list,size,size,tmpreg,ref);
  2361. end;
  2362. procedure thlcgobj.a_op_const_subsetreg(list: TAsmList; Op: TOpCG; size, subsetsize: tdef; a: tcgint; const sreg: tsubsetregister);
  2363. var
  2364. tmpreg: tregister;
  2365. begin
  2366. tmpreg:=getintregister(list,size);
  2367. a_load_subsetreg_reg(list,subsetsize,size,sreg,tmpreg);
  2368. a_op_const_reg(list,op,size,a,tmpreg);
  2369. a_load_reg_subsetreg(list,size,subsetsize,tmpreg,sreg);
  2370. end;
  2371. procedure thlcgobj.a_op_const_subsetref(list: TAsmList; Op: TOpCG; size, subsetsize: tdef; a: tcgint; const sref: tsubsetreference);
  2372. var
  2373. tmpreg: tregister;
  2374. begin
  2375. tmpreg:=getintregister(list,size);
  2376. a_load_subsetref_reg(list,subsetsize,size,sref,tmpreg);
  2377. a_op_const_reg(list,op,size,a,tmpreg);
  2378. a_load_reg_subsetref(list,size,subsetsize,tmpreg,sref);
  2379. end;
  2380. procedure thlcgobj.a_op_const_loc(list: TAsmList; Op: TOpCG; size: tdef; a: tcgint; const loc: tlocation);
  2381. begin
  2382. case loc.loc of
  2383. LOC_REGISTER, LOC_CREGISTER:
  2384. a_op_const_reg(list,op,size,a,loc.register);
  2385. LOC_REFERENCE, LOC_CREFERENCE:
  2386. a_op_const_ref(list,op,size,a,loc.reference);
  2387. LOC_SUBSETREG, LOC_CSUBSETREG:
  2388. a_op_const_subsetreg(list,op,size,size,a,loc.sreg);
  2389. LOC_SUBSETREF, LOC_CSUBSETREF:
  2390. a_op_const_subsetref(list,op,size,size,a,loc.sref);
  2391. else
  2392. internalerror(2010120428);
  2393. end;
  2394. end;
  2395. procedure thlcgobj.a_op_reg_ref(list: TAsmList; Op: TOpCG; size: tdef; reg: TRegister; const ref: TReference);
  2396. var
  2397. tmpreg: tregister;
  2398. begin
  2399. tmpreg:=getintregister(list,size);
  2400. a_load_ref_reg(list,size,size,ref,tmpreg);
  2401. case op of
  2402. OP_NOT,OP_NEG:
  2403. begin
  2404. a_op_reg_reg(list,op,size,tmpreg,tmpreg);
  2405. end;
  2406. else
  2407. begin
  2408. a_op_reg_reg(list,op,size,reg,tmpreg);
  2409. end;
  2410. end;
  2411. a_load_reg_ref(list,size,size,tmpreg,ref);
  2412. end;
  2413. procedure thlcgobj.a_op_ref_reg(list: TAsmList; Op: TOpCG; size: tdef; const ref: TReference; reg: TRegister);
  2414. var
  2415. tmpreg: tregister;
  2416. begin
  2417. case op of
  2418. OP_NOT,OP_NEG:
  2419. { handle it as "load ref,reg; op reg" }
  2420. begin
  2421. a_load_ref_reg(list,size,size,ref,reg);
  2422. a_op_reg_reg(list,op,size,reg,reg);
  2423. end;
  2424. else
  2425. begin
  2426. tmpreg:=getintregister(list,size);
  2427. a_load_ref_reg(list,size,size,ref,tmpreg);
  2428. a_op_reg_reg(list,op,size,tmpreg,reg);
  2429. end;
  2430. end;
  2431. end;
  2432. procedure thlcgobj.a_op_reg_subsetreg(list: TAsmList; Op: TOpCG; opsize, destsubsetsize: tdef; reg: TRegister; const sreg: tsubsetregister);
  2433. var
  2434. tmpreg: tregister;
  2435. begin
  2436. tmpreg:=getintregister(list,opsize);
  2437. a_load_subsetreg_reg(list,destsubsetsize,opsize,sreg,tmpreg);
  2438. a_op_reg_reg(list,op,opsize,reg,tmpreg);
  2439. a_load_reg_subsetreg(list,opsize,destsubsetsize,tmpreg,sreg);
  2440. end;
  2441. procedure thlcgobj.a_op_reg_subsetref(list: TAsmList; Op: TOpCG; opsize, destsubsetsize: tdef; reg: TRegister; const sref: tsubsetreference);
  2442. var
  2443. tmpreg: tregister;
  2444. begin
  2445. tmpreg:=getintregister(list,opsize);
  2446. a_load_subsetref_reg(list,destsubsetsize,opsize,sref,tmpreg);
  2447. a_op_reg_reg(list,op,opsize,reg,tmpreg);
  2448. a_load_reg_subsetref(list,opsize,destsubsetsize,tmpreg,sref);
  2449. end;
  2450. procedure thlcgobj.a_op_reg_loc(list: TAsmList; Op: TOpCG; size: tdef; reg: tregister; const loc: tlocation);
  2451. begin
  2452. case loc.loc of
  2453. LOC_REGISTER, LOC_CREGISTER:
  2454. a_op_reg_reg(list,op,size,reg,loc.register);
  2455. LOC_REFERENCE, LOC_CREFERENCE:
  2456. a_op_reg_ref(list,op,size,reg,loc.reference);
  2457. LOC_SUBSETREG, LOC_CSUBSETREG:
  2458. a_op_reg_subsetreg(list,op,size,size,reg,loc.sreg);
  2459. LOC_SUBSETREF, LOC_CSUBSETREF:
  2460. a_op_reg_subsetref(list,op,size,size,reg,loc.sref);
  2461. else
  2462. internalerror(2010120429);
  2463. end;
  2464. end;
  2465. procedure thlcgobj.a_op_ref_loc(list: TAsmList; Op: TOpCG; size: tdef; const ref: TReference; const loc: tlocation);
  2466. var
  2467. tmpreg: tregister;
  2468. begin
  2469. case loc.loc of
  2470. LOC_REGISTER,LOC_CREGISTER:
  2471. a_op_ref_reg(list,op,size,ref,loc.register);
  2472. LOC_REFERENCE,LOC_CREFERENCE:
  2473. begin
  2474. tmpreg:=getintregister(list,size);
  2475. a_load_ref_reg(list,size,size,ref,tmpreg);
  2476. a_op_reg_ref(list,op,size,tmpreg,loc.reference);
  2477. end;
  2478. LOC_SUBSETREG, LOC_CSUBSETREG:
  2479. begin
  2480. tmpreg:=getintregister(list,size);
  2481. a_load_subsetreg_reg(list,size,size,loc.sreg,tmpreg);
  2482. a_op_ref_reg(list,op,size,ref,tmpreg);
  2483. a_load_reg_subsetreg(list,size,size,tmpreg,loc.sreg);
  2484. end;
  2485. LOC_SUBSETREF, LOC_CSUBSETREF:
  2486. begin
  2487. tmpreg:=getintregister(list,size);
  2488. a_load_subsetref_reg(list,size,size,loc.sref,tmpreg);
  2489. a_op_ref_reg(list,op,size,ref,tmpreg);
  2490. a_load_reg_subsetref(list,size,size,tmpreg,loc.sref);
  2491. end;
  2492. else
  2493. internalerror(2010120429);
  2494. end;
  2495. end;
  2496. procedure thlcgobj.a_op_const_reg_reg(list: TAsmList; op: TOpCg; size: tdef; a: tcgint; src, dst: tregister);
  2497. begin
  2498. a_load_reg_reg(list,size,size,src,dst);
  2499. a_op_const_reg(list,op,size,a,dst);
  2500. end;
  2501. procedure thlcgobj.a_op_reg_reg_reg(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister);
  2502. var
  2503. tmpreg: tregister;
  2504. begin
  2505. if (dst<>src1) then
  2506. begin
  2507. a_load_reg_reg(list,size,size,src2,dst);
  2508. a_op_reg_reg(list,op,size,src1,dst);
  2509. end
  2510. else
  2511. begin
  2512. { can we do a direct operation on the target register ? }
  2513. if op in [OP_ADD,OP_MUL,OP_AND,OP_MOVE,OP_XOR,OP_IMUL,OP_OR] then
  2514. a_op_reg_reg(list,op,size,src2,dst)
  2515. else
  2516. begin
  2517. tmpreg:=getintregister(list,size);
  2518. a_load_reg_reg(list,size,size,src2,tmpreg);
  2519. a_op_reg_reg(list,op,size,src1,tmpreg);
  2520. a_load_reg_reg(list,size,size,tmpreg,dst);
  2521. end;
  2522. end;
  2523. end;
  2524. procedure thlcgobj.a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; a: tcgint; src, dst: tregister; setflags: boolean; var ovloc: tlocation);
  2525. begin
  2526. ovloc.loc:=LOC_VOID;
  2527. if not setflags then
  2528. a_op_const_reg_reg(list,op,size,a,src,dst)
  2529. else
  2530. internalerror(2010122910);
  2531. end;
  2532. procedure thlcgobj.a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister; setflags: boolean; var ovloc: tlocation);
  2533. begin
  2534. ovloc.loc:=LOC_VOID;
  2535. if not setflags then
  2536. a_op_reg_reg_reg(list,op,size,src1,src2,dst)
  2537. else
  2538. internalerror(2010122911);
  2539. end;
  2540. procedure thlcgobj.a_cmp_const_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; reg: tregister; l: tasmlabel);
  2541. var
  2542. tmpreg: tregister;
  2543. begin
  2544. tmpreg:=getintregister(list,size);
  2545. a_load_const_reg(list,size,a,tmpreg);
  2546. a_cmp_reg_reg_label(list,size,cmp_op,tmpreg,reg,l);
  2547. end;
  2548. procedure thlcgobj.a_cmp_const_ref_label(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; const ref: treference; l: tasmlabel);
  2549. var
  2550. tmpreg: tregister;
  2551. begin
  2552. tmpreg:=getintregister(list,size);
  2553. a_load_ref_reg(list,size,size,ref,tmpreg);
  2554. a_cmp_const_reg_label(list,size,cmp_op,a,tmpreg,l);
  2555. end;
  2556. procedure thlcgobj.a_cmp_const_loc_label(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; const loc: tlocation; l: tasmlabel);
  2557. var
  2558. tmpreg: tregister;
  2559. begin
  2560. case loc.loc of
  2561. LOC_REGISTER,LOC_CREGISTER:
  2562. a_cmp_const_reg_label(list,size,cmp_op,a,loc.register,l);
  2563. LOC_REFERENCE,LOC_CREFERENCE:
  2564. a_cmp_const_ref_label(list,size,cmp_op,a,loc.reference,l);
  2565. LOC_SUBSETREG, LOC_CSUBSETREG:
  2566. begin
  2567. tmpreg:=getintregister(list,size);
  2568. a_load_subsetreg_reg(list,size,size,loc.sreg,tmpreg);
  2569. a_cmp_const_reg_label(list,size,cmp_op,a,tmpreg,l);
  2570. end;
  2571. LOC_SUBSETREF, LOC_CSUBSETREF:
  2572. begin
  2573. tmpreg:=getintregister(list,size);
  2574. a_load_subsetref_reg(list,size,size,loc.sref,tmpreg);
  2575. a_cmp_const_reg_label(list,size,cmp_op,a,tmpreg,l);
  2576. end;
  2577. else
  2578. internalerror(2010120430);
  2579. end;
  2580. end;
  2581. procedure thlcgobj.a_cmp_ref_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; const ref: treference; reg: tregister; l: tasmlabel);
  2582. var
  2583. tmpreg: tregister;
  2584. begin
  2585. tmpreg:=getintregister(list,size);
  2586. a_load_ref_reg(list,size,size,ref,tmpreg);
  2587. a_cmp_reg_reg_label(list,size,cmp_op,tmpreg,reg,l);
  2588. end;
  2589. procedure thlcgobj.a_cmp_reg_ref_label(list: TAsmList; size: tdef; cmp_op: topcmp; reg: tregister; const ref: treference; l: tasmlabel);
  2590. var
  2591. tmpreg: tregister;
  2592. begin
  2593. tmpreg:=getintregister(list,size);
  2594. a_load_ref_reg(list,size,size,ref,tmpreg);
  2595. a_cmp_reg_reg_label(list,size,cmp_op,reg,tmpreg,l);
  2596. end;
  2597. procedure thlcgobj.a_cmp_subsetreg_reg_label(list: TAsmList; fromsubsetsize, cmpsize: tdef; cmp_op: topcmp; const sreg: tsubsetregister; reg: tregister; l: tasmlabel);
  2598. var
  2599. tmpreg: tregister;
  2600. begin
  2601. tmpreg:=getintregister(list,cmpsize);
  2602. a_load_subsetreg_reg(list,fromsubsetsize,cmpsize,sreg,tmpreg);
  2603. a_cmp_reg_reg_label(list,cmpsize,cmp_op,tmpreg,reg,l);
  2604. end;
  2605. procedure thlcgobj.a_cmp_subsetref_reg_label(list: TAsmList; fromsubsetsize, cmpsize: tdef; cmp_op: topcmp; const sref: tsubsetreference; reg: tregister; l: tasmlabel);
  2606. var
  2607. tmpreg: tregister;
  2608. begin
  2609. tmpreg:=getintregister(list,cmpsize);
  2610. a_load_subsetref_reg(list,fromsubsetsize,cmpsize,sref,tmpreg);
  2611. a_cmp_reg_reg_label(list,cmpsize,cmp_op,tmpreg,reg,l);
  2612. end;
  2613. procedure thlcgobj.a_cmp_loc_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; const loc: tlocation; reg: tregister; l: tasmlabel);
  2614. begin
  2615. case loc.loc of
  2616. LOC_REGISTER,
  2617. LOC_CREGISTER:
  2618. a_cmp_reg_reg_label(list,size,cmp_op,loc.register,reg,l);
  2619. LOC_REFERENCE,
  2620. LOC_CREFERENCE :
  2621. a_cmp_ref_reg_label(list,size,cmp_op,loc.reference,reg,l);
  2622. LOC_CONSTANT:
  2623. a_cmp_const_reg_label(list,size,cmp_op,loc.value,reg,l);
  2624. LOC_SUBSETREG,
  2625. LOC_CSUBSETREG:
  2626. a_cmp_subsetreg_reg_label(list,size,size,cmp_op,loc.sreg,reg,l);
  2627. LOC_SUBSETREF,
  2628. LOC_CSUBSETREF:
  2629. a_cmp_subsetref_reg_label(list,size,size,cmp_op,loc.sref,reg,l);
  2630. else
  2631. internalerror(2010120431);
  2632. end;
  2633. end;
  2634. procedure thlcgobj.a_cmp_reg_loc_label(list: TAsmList; size: tdef; cmp_op: topcmp; reg: tregister; const loc: tlocation; l: tasmlabel);
  2635. begin
  2636. a_cmp_loc_reg_label(list,size,swap_opcmp(cmp_op),loc,reg,l);
  2637. end;
  2638. procedure thlcgobj.a_cmp_ref_loc_label(list: TAsmList; size: tdef; cmp_op: topcmp; const ref: treference; const loc: tlocation; l: tasmlabel);
  2639. var
  2640. tmpreg: tregister;
  2641. begin
  2642. case loc.loc of
  2643. LOC_REGISTER,LOC_CREGISTER:
  2644. a_cmp_ref_reg_label(list,size,cmp_op,ref,loc.register,l);
  2645. LOC_REFERENCE,LOC_CREFERENCE:
  2646. begin
  2647. tmpreg:=getintregister(list,size);
  2648. a_load_ref_reg(list,size,size,loc.reference,tmpreg);
  2649. a_cmp_ref_reg_label(list,size,cmp_op,ref,tmpreg,l);
  2650. end;
  2651. LOC_CONSTANT:
  2652. begin
  2653. a_cmp_const_ref_label(list,size,swap_opcmp(cmp_op),loc.value,ref,l);
  2654. end;
  2655. LOC_SUBSETREG, LOC_CSUBSETREG:
  2656. begin
  2657. tmpreg:=getintregister(list,size);
  2658. a_load_ref_reg(list,size,size,loc.reference,tmpreg);
  2659. a_cmp_subsetreg_reg_label(list,size,size,swap_opcmp(cmp_op),loc.sreg,tmpreg,l);
  2660. end;
  2661. LOC_SUBSETREF, LOC_CSUBSETREF:
  2662. begin
  2663. tmpreg:=getintregister(list,size);
  2664. a_load_ref_reg(list,size,size,loc.reference,tmpreg);
  2665. a_cmp_subsetref_reg_label(list,size,size,swap_opcmp(cmp_op),loc.sref,tmpreg,l);
  2666. end;
  2667. else
  2668. internalerror(2010120432);
  2669. end;
  2670. end;
  2671. procedure thlcgobj.g_maybe_testself(list: TAsmList; selftype: tdef; reg: tregister);
  2672. var
  2673. OKLabel : tasmlabel;
  2674. cgpara1 : TCGPara;
  2675. pd : tprocdef;
  2676. begin
  2677. if (cs_check_object in current_settings.localswitches) or
  2678. (cs_check_range in current_settings.localswitches) then
  2679. begin
  2680. pd:=search_system_proc('fpc_handleerror');
  2681. current_asmdata.getjumplabel(oklabel);
  2682. a_cmp_const_reg_label(list,selftype,OC_NE,0,reg,oklabel);
  2683. cgpara1.init;
  2684. paramanager.getintparaloc(pd,1,cgpara1);
  2685. a_load_const_cgpara(list,s32inttype,aint(210),cgpara1);
  2686. paramanager.freecgpara(list,cgpara1);
  2687. g_call_system_proc(list,pd,nil);
  2688. cgpara1.done;
  2689. a_label(list,oklabel);
  2690. end;
  2691. end;
  2692. procedure thlcgobj.g_concatcopy(list: TAsmList; size: tdef; const source, dest: treference);
  2693. begin
  2694. if use_vectorfpu(size) then
  2695. a_loadmm_ref_ref(list,size,size,source,dest,mms_movescalar)
  2696. else if size.typ<>floatdef then
  2697. a_load_ref_ref(list,size,size,source,dest)
  2698. else
  2699. a_loadfpu_ref_ref(list,size,size,source,dest);
  2700. end;
  2701. procedure thlcgobj.g_concatcopy_unaligned(list: TAsmList; size: tdef; const source, dest: treference);
  2702. begin
  2703. g_concatcopy(list,size,source,dest);
  2704. end;
  2705. procedure thlcgobj.g_copyshortstring(list: TAsmList; const source, dest: treference; strdef: tstringdef);
  2706. var
  2707. cgpara1,cgpara2,cgpara3 : TCGPara;
  2708. pd : tprocdef;
  2709. begin
  2710. pd:=search_system_proc('fpc_shortstr_to_shortstr');
  2711. cgpara1.init;
  2712. cgpara2.init;
  2713. cgpara3.init;
  2714. paramanager.getintparaloc(pd,1,cgpara1);
  2715. paramanager.getintparaloc(pd,2,cgpara2);
  2716. paramanager.getintparaloc(pd,3,cgpara3);
  2717. if pd.is_pushleftright then
  2718. begin
  2719. a_loadaddr_ref_cgpara(list,strdef,dest,cgpara1);
  2720. a_load_const_cgpara(list,s32inttype,strdef.len,cgpara2);
  2721. a_loadaddr_ref_cgpara(list,strdef,source,cgpara3);
  2722. end
  2723. else
  2724. begin
  2725. a_loadaddr_ref_cgpara(list,strdef,source,cgpara3);
  2726. a_load_const_cgpara(list,s32inttype,strdef.len,cgpara2);
  2727. a_loadaddr_ref_cgpara(list,strdef,dest,cgpara1);
  2728. end;
  2729. paramanager.freecgpara(list,cgpara3);
  2730. paramanager.freecgpara(list,cgpara2);
  2731. paramanager.freecgpara(list,cgpara1);
  2732. g_call_system_proc(list,pd,nil);
  2733. cgpara3.done;
  2734. cgpara2.done;
  2735. cgpara1.done;
  2736. end;
  2737. procedure thlcgobj.g_copyvariant(list: TAsmList; const source, dest: treference; vardef: tvariantdef);
  2738. var
  2739. cgpara1,cgpara2 : TCGPara;
  2740. pd : tprocdef;
  2741. begin
  2742. pd:=search_system_proc('fpc_variant_copy_overwrite');
  2743. cgpara1.init;
  2744. cgpara2.init;
  2745. paramanager.getintparaloc(pd,1,cgpara1);
  2746. paramanager.getintparaloc(pd,2,cgpara2);
  2747. if pd.is_pushleftright then
  2748. begin
  2749. a_loadaddr_ref_cgpara(list,vardef,source,cgpara1);
  2750. a_loadaddr_ref_cgpara(list,vardef,dest,cgpara2);
  2751. end
  2752. else
  2753. begin
  2754. a_loadaddr_ref_cgpara(list,vardef,dest,cgpara2);
  2755. a_loadaddr_ref_cgpara(list,vardef,source,cgpara1);
  2756. end;
  2757. paramanager.freecgpara(list,cgpara2);
  2758. paramanager.freecgpara(list,cgpara1);
  2759. g_call_system_proc(list,pd,nil);
  2760. cgpara2.done;
  2761. cgpara1.done;
  2762. end;
  2763. procedure thlcgobj.g_incrrefcount(list: TAsmList; t: tdef; const ref: treference);
  2764. var
  2765. href : treference;
  2766. incrfunc : string;
  2767. cgpara1,cgpara2 : TCGPara;
  2768. pd : tprocdef;
  2769. begin
  2770. cgpara1.init;
  2771. cgpara2.init;
  2772. if is_interfacecom_or_dispinterface(t) then
  2773. incrfunc:='fpc_intf_incr_ref'
  2774. else if is_ansistring(t) then
  2775. incrfunc:='fpc_ansistr_incr_ref'
  2776. else if is_widestring(t) then
  2777. incrfunc:='fpc_widestr_incr_ref'
  2778. else if is_unicodestring(t) then
  2779. incrfunc:='fpc_unicodestr_incr_ref'
  2780. else if is_dynamic_array(t) then
  2781. incrfunc:='fpc_dynarray_incr_ref'
  2782. else
  2783. incrfunc:='';
  2784. { call the special incr function or the generic addref }
  2785. if incrfunc<>'' then
  2786. begin
  2787. pd:=search_system_proc(incrfunc);
  2788. paramanager.getintparaloc(pd,1,cgpara1);
  2789. { widestrings aren't ref. counted on all platforms so we need the address
  2790. to create a real copy }
  2791. if is_widestring(t) then
  2792. a_loadaddr_ref_cgpara(list,t,ref,cgpara1)
  2793. else
  2794. { these functions get the pointer by value }
  2795. a_load_ref_cgpara(list,t,ref,cgpara1);
  2796. paramanager.freecgpara(list,cgpara1);
  2797. g_call_system_proc(list,pd,nil);
  2798. end
  2799. else
  2800. begin
  2801. pd:=search_system_proc('fpc_addref');
  2802. paramanager.getintparaloc(pd,1,cgpara1);
  2803. paramanager.getintparaloc(pd,2,cgpara2);
  2804. if is_open_array(t) then
  2805. InternalError(201103054);
  2806. reference_reset_symbol(href,RTTIWriter.get_rtti_label(t,initrtti,tf_supports_packages in target_info.flags),0,sizeof(pint));
  2807. if pd.is_pushleftright then
  2808. begin
  2809. a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
  2810. if tf_supports_packages in target_info.flags then
  2811. a_load_ref_cgpara(list,voidpointertype,href,cgpara2)
  2812. else
  2813. a_loadaddr_ref_cgpara(list,voidpointertype,href,cgpara2);
  2814. end
  2815. else
  2816. begin
  2817. if tf_supports_packages in target_info.flags then
  2818. a_load_ref_cgpara(list,voidpointertype,href,cgpara2)
  2819. else
  2820. a_loadaddr_ref_cgpara(list,voidpointertype,href,cgpara2);
  2821. a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
  2822. end;
  2823. paramanager.freecgpara(list,cgpara1);
  2824. paramanager.freecgpara(list,cgpara2);
  2825. g_call_system_proc(list,pd,nil);
  2826. end;
  2827. cgpara2.done;
  2828. cgpara1.done;
  2829. end;
  2830. procedure thlcgobj.g_initialize(list: TAsmList; t: tdef; const ref: treference);
  2831. var
  2832. href : treference;
  2833. cgpara1,cgpara2 : TCGPara;
  2834. pd : tprocdef;
  2835. begin
  2836. cgpara1.init;
  2837. cgpara2.init;
  2838. if is_ansistring(t) or
  2839. is_widestring(t) or
  2840. is_unicodestring(t) or
  2841. is_interfacecom_or_dispinterface(t) or
  2842. is_dynamic_array(t) then
  2843. a_load_const_ref(list,t,0,ref)
  2844. else if t.typ=variantdef then
  2845. begin
  2846. pd:=search_system_proc('fpc_variant_init');
  2847. paramanager.getintparaloc(pd,1,cgpara1);
  2848. a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
  2849. paramanager.freecgpara(list,cgpara1);
  2850. g_call_system_proc(list,pd,nil);
  2851. end
  2852. else
  2853. begin
  2854. if is_open_array(t) then
  2855. InternalError(201103052);
  2856. pd:=search_system_proc('fpc_initialize');
  2857. paramanager.getintparaloc(pd,1,cgpara1);
  2858. paramanager.getintparaloc(pd,2,cgpara2);
  2859. reference_reset_symbol(href,RTTIWriter.get_rtti_label(t,initrtti,tf_supports_packages in target_info.flags),0,sizeof(pint));
  2860. if pd.is_pushleftright then
  2861. begin
  2862. a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
  2863. if tf_supports_packages in target_info.flags then
  2864. a_load_ref_cgpara(list,voidpointertype,href,cgpara2)
  2865. else
  2866. a_loadaddr_ref_cgpara(list,voidpointertype,href,cgpara2);
  2867. end
  2868. else
  2869. begin
  2870. if tf_supports_packages in target_info.flags then
  2871. a_load_ref_cgpara(list,voidpointertype,href,cgpara2)
  2872. else
  2873. a_loadaddr_ref_cgpara(list,voidpointertype,href,cgpara2);
  2874. a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
  2875. end;
  2876. paramanager.freecgpara(list,cgpara1);
  2877. paramanager.freecgpara(list,cgpara2);
  2878. g_call_system_proc(list,pd,nil);
  2879. end;
  2880. cgpara1.done;
  2881. cgpara2.done;
  2882. end;
  2883. procedure thlcgobj.g_finalize(list: TAsmList; t: tdef; const ref: treference);
  2884. var
  2885. href : treference;
  2886. cgpara1,cgpara2 : TCGPara;
  2887. pd : tprocdef;
  2888. decrfunc : string;
  2889. begin
  2890. if is_interfacecom_or_dispinterface(t) then
  2891. decrfunc:='fpc_intf_decr_ref'
  2892. else if is_ansistring(t) then
  2893. decrfunc:='fpc_ansistr_decr_ref'
  2894. else if is_widestring(t) then
  2895. decrfunc:='fpc_widestr_decr_ref'
  2896. else if is_unicodestring(t) then
  2897. decrfunc:='fpc_unicodestr_decr_ref'
  2898. else if t.typ=variantdef then
  2899. decrfunc:='fpc_variant_clear'
  2900. else
  2901. begin
  2902. cgpara1.init;
  2903. cgpara2.init;
  2904. if is_open_array(t) then
  2905. InternalError(201103051);
  2906. { fpc_finalize takes a pointer value parameter, fpc_dynarray_clear a
  2907. pointer var parameter }
  2908. if is_dynamic_array(t) then
  2909. pd:=search_system_proc('fpc_dynarray_clear')
  2910. else
  2911. pd:=search_system_proc('fpc_finalize');
  2912. paramanager.getintparaloc(pd,1,cgpara1);
  2913. paramanager.getintparaloc(pd,2,cgpara2);
  2914. reference_reset_symbol(href,RTTIWriter.get_rtti_label(t,initrtti,tf_supports_packages in target_info.flags),0,sizeof(pint));
  2915. if pd.is_pushleftright then
  2916. begin
  2917. a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
  2918. if tf_supports_packages in target_info.flags then
  2919. a_load_ref_cgpara(list,voidpointertype,href,cgpara2)
  2920. else
  2921. a_loadaddr_ref_cgpara(list,voidpointertype,href,cgpara2);
  2922. end
  2923. else
  2924. begin
  2925. if tf_supports_packages in target_info.flags then
  2926. a_load_ref_cgpara(list,voidpointertype,href,cgpara2)
  2927. else
  2928. a_loadaddr_ref_cgpara(list,voidpointertype,href,cgpara2);
  2929. a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
  2930. end;
  2931. paramanager.freecgpara(list,cgpara1);
  2932. paramanager.freecgpara(list,cgpara2);
  2933. g_call_system_proc(list,pd,nil);
  2934. cgpara1.done;
  2935. cgpara2.done;
  2936. exit;
  2937. end;
  2938. pd:=search_system_proc(decrfunc);
  2939. cgpara1.init;
  2940. paramanager.getintparaloc(pd,1,cgpara1);
  2941. a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
  2942. paramanager.freecgpara(list,cgpara1);
  2943. g_call_system_proc(list,pd,nil);
  2944. cgpara1.done;
  2945. end;
  2946. procedure thlcgobj.g_array_rtti_helper(list: TAsmList; t: tdef; const ref: treference; const highloc: tlocation; const name: string);
  2947. var
  2948. cgpara1,cgpara2,cgpara3: TCGPara;
  2949. href: TReference;
  2950. hreg, lenreg: TRegister;
  2951. pd: tprocdef;
  2952. begin
  2953. cgpara1.init;
  2954. cgpara2.init;
  2955. cgpara3.init;
  2956. pd:=search_system_proc(name);
  2957. paramanager.getintparaloc(pd,1,cgpara1);
  2958. paramanager.getintparaloc(pd,2,cgpara2);
  2959. paramanager.getintparaloc(pd,3,cgpara3);
  2960. reference_reset_symbol(href,RTTIWriter.get_rtti_label(t,initrtti,tf_supports_packages in target_info.flags),0,sizeof(pint));
  2961. { if calling convention is left to right, push parameters 1 and 2 }
  2962. if pd.is_pushleftright then
  2963. begin
  2964. a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
  2965. if tf_supports_packages in target_info.flags then
  2966. a_load_ref_cgpara(list,voidpointertype,href,cgpara2)
  2967. else
  2968. a_loadaddr_ref_cgpara(list,voidpointertype,href,cgpara2);
  2969. end;
  2970. { push parameter 3 }
  2971. if highloc.loc=LOC_CONSTANT then
  2972. a_load_const_cgpara(list,ptrsinttype,highloc.value+1,cgpara3)
  2973. else
  2974. begin
  2975. if highloc.loc in [LOC_REGISTER,LOC_CREGISTER] then
  2976. hreg:=highloc.register
  2977. else
  2978. begin
  2979. hreg:=getintregister(list,ptrsinttype);
  2980. a_load_loc_reg(list,ptrsinttype,ptrsinttype,highloc,hreg);
  2981. end;
  2982. { increment, converts high(x) to length(x) }
  2983. lenreg:=getintregister(list,ptrsinttype);
  2984. a_op_const_reg_reg(list,OP_ADD,ptrsinttype,1,hreg,lenreg);
  2985. a_load_reg_cgpara(list,ptrsinttype,lenreg,cgpara3);
  2986. end;
  2987. { if calling convention is right to left, push parameters 2 and 1 }
  2988. if not pd.is_pushleftright then
  2989. begin
  2990. if tf_supports_packages in target_info.flags then
  2991. a_load_ref_cgpara(list,voidpointertype,href,cgpara2)
  2992. else
  2993. a_loadaddr_ref_cgpara(list,voidpointertype,href,cgpara2);
  2994. a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
  2995. end;
  2996. paramanager.freecgpara(list,cgpara1);
  2997. paramanager.freecgpara(list,cgpara2);
  2998. paramanager.freecgpara(list,cgpara3);
  2999. g_call_system_proc(list,pd,nil);
  3000. cgpara3.done;
  3001. cgpara2.done;
  3002. cgpara1.done;
  3003. end;
  3004. procedure thlcgobj.g_rangecheck(list: TAsmList; const l: tlocation; fromdef, todef: tdef);
  3005. var
  3006. {$if defined(cpu64bitalu) or defined(cpu32bitalu)}
  3007. aintmax: aint;
  3008. {$else}
  3009. aintmax: longint;
  3010. {$endif}
  3011. neglabel : tasmlabel;
  3012. hreg : tregister;
  3013. lto,hto,
  3014. lfrom,hfrom : TConstExprInt;
  3015. fromsize, tosize: cardinal;
  3016. maxdef: tdef;
  3017. from_signed, to_signed: boolean;
  3018. begin
  3019. { range checking on and range checkable value? }
  3020. if not(cs_check_range in current_settings.localswitches) or
  3021. not(fromdef.typ in [orddef,enumdef]) or
  3022. { C-style booleans can't really fail range checks, }
  3023. { all values are always valid }
  3024. is_cbool(todef) then
  3025. exit;
  3026. {$if not defined(cpuhighleveltarget) and not defined(cpu64bitalu)}
  3027. { handle 64bit rangechecks separate for 32bit processors }
  3028. if is_64bit(fromdef) or is_64bit(todef) then
  3029. begin
  3030. cg64.g_rangecheck64(list,l,fromdef,todef);
  3031. exit;
  3032. end;
  3033. {$endif ndef cpuhighleveltarget and ndef cpu64bitalu}
  3034. { only check when assigning to scalar, subranges are different, }
  3035. { when todef=fromdef then the check is always generated }
  3036. getrange(fromdef,lfrom,hfrom);
  3037. getrange(todef,lto,hto);
  3038. from_signed := is_signed(fromdef);
  3039. to_signed := is_signed(todef);
  3040. { check the rangedef of the array, not the array itself }
  3041. { (only change now, since getrange needs the arraydef) }
  3042. if (todef.typ = arraydef) then
  3043. todef := tarraydef(todef).rangedef;
  3044. { no range check if from and to are equal and are both longint/dword }
  3045. { (if we have a 32bit processor) or int64/qword, since such }
  3046. { operations can at most cause overflows (JM) }
  3047. { Note that these checks are mostly processor independent, they only }
  3048. { have to be changed once we introduce 64bit subrange types }
  3049. {$if defined(cpuhighleveltarget) or defined(cpu64bitalu)}
  3050. if (fromdef=todef) and
  3051. (fromdef.typ=orddef) and
  3052. (((((torddef(fromdef).ordtype=s64bit) and
  3053. (lfrom = low(int64)) and
  3054. (hfrom = high(int64))) or
  3055. ((torddef(fromdef).ordtype=u64bit) and
  3056. (lfrom = low(qword)) and
  3057. (hfrom = high(qword))) or
  3058. ((torddef(fromdef).ordtype=scurrency) and
  3059. (lfrom = low(int64)) and
  3060. (hfrom = high(int64)))))) then
  3061. exit;
  3062. {$endif cpuhighleveltarget or cpu64bitalu}
  3063. { 32 bit operations are automatically widened to 64 bit on 64 bit addr
  3064. targets }
  3065. {$ifdef cpu32bitaddr}
  3066. if (fromdef = todef) and
  3067. (fromdef.typ=orddef) and
  3068. (((((torddef(fromdef).ordtype = s32bit) and
  3069. (lfrom = int64(low(longint))) and
  3070. (hfrom = int64(high(longint)))) or
  3071. ((torddef(fromdef).ordtype = u32bit) and
  3072. (lfrom = low(cardinal)) and
  3073. (hfrom = high(cardinal)))))) then
  3074. exit;
  3075. {$endif cpu32bitaddr}
  3076. { optimize some range checks away in safe cases }
  3077. fromsize := fromdef.size;
  3078. tosize := todef.size;
  3079. if ((from_signed = to_signed) or
  3080. (not from_signed)) and
  3081. (lto<=lfrom) and (hto>=hfrom) and
  3082. (fromsize <= tosize) then
  3083. begin
  3084. { if fromsize < tosize, and both have the same signed-ness or }
  3085. { fromdef is unsigned, then all bit patterns from fromdef are }
  3086. { valid for todef as well }
  3087. if (fromsize < tosize) then
  3088. exit;
  3089. if (fromsize = tosize) and
  3090. (from_signed = to_signed) then
  3091. { only optimize away if all bit patterns which fit in fromsize }
  3092. { are valid for the todef }
  3093. begin
  3094. {$ifopt Q+}
  3095. {$define overflowon}
  3096. {$Q-}
  3097. {$endif}
  3098. {$ifopt R+}
  3099. {$define rangeon}
  3100. {$R-}
  3101. {$endif}
  3102. if to_signed then
  3103. begin
  3104. { calculation of the low/high ranges must not overflow 64 bit
  3105. otherwise we end up comparing with zero for 64 bit data types on
  3106. 64 bit processors }
  3107. if (lto = (int64(-1) << (tosize * 8 - 1))) and
  3108. (hto = (-((int64(-1) << (tosize * 8 - 1))+1))) then
  3109. exit
  3110. end
  3111. else
  3112. begin
  3113. { calculation of the low/high ranges must not overflow 64 bit
  3114. otherwise we end up having all zeros for 64 bit data types on
  3115. 64 bit processors }
  3116. if (lto = 0) and
  3117. (qword(hto) = (qword(-1) >> (64-(tosize * 8))) ) then
  3118. exit
  3119. end;
  3120. {$ifdef overflowon}
  3121. {$Q+}
  3122. {$undef overflowon}
  3123. {$endif}
  3124. {$ifdef rangeon}
  3125. {$R+}
  3126. {$undef rangeon}
  3127. {$endif}
  3128. end
  3129. end;
  3130. { depending on the types involved, we perform the range check for 64 or
  3131. for 32 bit }
  3132. if fromsize=8 then
  3133. maxdef:=fromdef
  3134. else
  3135. maxdef:=todef;
  3136. {$if sizeof(aintmax) = 8}
  3137. if maxdef.size=8 then
  3138. aintmax:=high(int64)
  3139. else
  3140. {$endif}
  3141. begin
  3142. aintmax:=high(longint);
  3143. maxdef:=u32inttype;
  3144. end;
  3145. { generate the rangecheck code for the def where we are going to }
  3146. { store the result }
  3147. { use the trick that }
  3148. { a <= x <= b <=> 0 <= x-a <= b-a <=> unsigned(x-a) <= unsigned(b-a) }
  3149. { To be able to do that, we have to make sure however that either }
  3150. { fromdef and todef are both signed or unsigned, or that we leave }
  3151. { the parts < 0 and > maxlongint out }
  3152. if from_signed xor to_signed then
  3153. begin
  3154. if from_signed then
  3155. { from is signed, to is unsigned }
  3156. begin
  3157. { if high(from) < 0 -> always range error }
  3158. if (hfrom < 0) or
  3159. { if low(to) > maxlongint also range error }
  3160. (lto > aintmax) then
  3161. begin
  3162. g_call_system_proc(list,'fpc_rangeerror',nil);
  3163. exit
  3164. end;
  3165. { from is signed and to is unsigned -> when looking at to }
  3166. { as an signed value, it must be < maxaint (otherwise }
  3167. { it will become negative, which is invalid since "to" is unsigned) }
  3168. if hto > aintmax then
  3169. hto := aintmax;
  3170. end
  3171. else
  3172. { from is unsigned, to is signed }
  3173. begin
  3174. if (lfrom > aintmax) or
  3175. (hto < 0) then
  3176. begin
  3177. g_call_system_proc(list,'fpc_rangeerror',nil);
  3178. exit
  3179. end;
  3180. { from is unsigned and to is signed -> when looking at to }
  3181. { as an unsigned value, it must be >= 0 (since negative }
  3182. { values are the same as values > maxlongint) }
  3183. if lto < 0 then
  3184. lto := 0;
  3185. end;
  3186. end;
  3187. hreg:=getintregister(list,maxdef);
  3188. a_load_loc_reg(list,fromdef,maxdef,l,hreg);
  3189. a_op_const_reg(list,OP_SUB,maxdef,tcgint(int64(lto)),hreg);
  3190. current_asmdata.getjumplabel(neglabel);
  3191. {
  3192. if from_signed then
  3193. a_cmp_const_reg_label(list,OS_INT,OC_GTE,aint(hto-lto),hreg,neglabel)
  3194. else
  3195. }
  3196. if qword(hto-lto)>qword(aintmax) then
  3197. a_cmp_const_reg_label(list,maxdef,OC_BE,aintmax,hreg,neglabel)
  3198. else
  3199. a_cmp_const_reg_label(list,maxdef,OC_BE,tcgint(int64(hto-lto)),hreg,neglabel);
  3200. g_call_system_proc(list,'fpc_rangeerror',nil);
  3201. a_label(list,neglabel);
  3202. end;
  3203. procedure thlcgobj.g_copyvaluepara_openarray(list: TAsmList; const ref: treference; const lenloc: tlocation; arrdef: tarraydef; destreg: tregister);
  3204. var
  3205. sizereg,sourcereg,lenreg : tregister;
  3206. cgpara1,cgpara2,cgpara3 : TCGPara;
  3207. ptrarrdef : tdef;
  3208. pd : tprocdef;
  3209. getmemres : tcgpara;
  3210. destloc : tlocation;
  3211. begin
  3212. { because some abis don't support dynamic stack allocation properly
  3213. open array value parameters are copied onto the heap
  3214. }
  3215. { calculate necessary memory }
  3216. { read/write operations on one register make the life of the register allocator hard }
  3217. if not(lenloc.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  3218. begin
  3219. lenreg:=getintregister(list,sinttype);
  3220. a_load_loc_reg(list,sinttype,sinttype,lenloc,lenreg);
  3221. end
  3222. else
  3223. lenreg:=lenloc.register;
  3224. sizereg:=getintregister(list,sinttype);
  3225. a_op_const_reg_reg(list,OP_ADD,sinttype,1,lenreg,sizereg);
  3226. a_op_const_reg(list,OP_IMUL,sinttype,arrdef.elesize,sizereg);
  3227. { load source }
  3228. ptrarrdef:=getpointerdef(arrdef);
  3229. sourcereg:=getaddressregister(list,ptrarrdef);
  3230. a_loadaddr_ref_reg(list,arrdef,ptrarrdef,ref,sourcereg);
  3231. { do getmem call }
  3232. pd:=search_system_proc('fpc_getmem');
  3233. cgpara1.init;
  3234. paramanager.getintparaloc(pd,1,cgpara1);
  3235. a_load_reg_cgpara(list,sinttype,sizereg,cgpara1);
  3236. paramanager.freecgpara(list,cgpara1);
  3237. getmemres:=g_call_system_proc(list,pd,ptrarrdef);
  3238. cgpara1.done;
  3239. { return the new address }
  3240. location_reset(destloc,LOC_REGISTER,OS_ADDR);
  3241. destloc.register:=destreg;
  3242. gen_load_cgpara_loc(list,ptrarrdef,getmemres,destloc,false);
  3243. { do move call }
  3244. pd:=search_system_proc('MOVE');
  3245. cgpara1.init;
  3246. cgpara2.init;
  3247. cgpara3.init;
  3248. paramanager.getintparaloc(pd,1,cgpara1);
  3249. paramanager.getintparaloc(pd,2,cgpara2);
  3250. paramanager.getintparaloc(pd,3,cgpara3);
  3251. if pd.is_pushleftright then
  3252. begin
  3253. { load source }
  3254. a_load_reg_cgpara(list,ptrarrdef,sourcereg,cgpara1);
  3255. { load destination }
  3256. a_load_reg_cgpara(list,ptrarrdef,destreg,cgpara2);
  3257. { load size }
  3258. a_load_reg_cgpara(list,ptrsinttype,sizereg,cgpara3);
  3259. end
  3260. else
  3261. begin
  3262. { load size }
  3263. a_load_reg_cgpara(list,ptrsinttype,sizereg,cgpara3);
  3264. { load destination }
  3265. a_load_reg_cgpara(list,ptrarrdef,destreg,cgpara2);
  3266. { load source }
  3267. a_load_reg_cgpara(list,ptrarrdef,sourcereg,cgpara1);
  3268. end;
  3269. paramanager.freecgpara(list,cgpara3);
  3270. paramanager.freecgpara(list,cgpara2);
  3271. paramanager.freecgpara(list,cgpara1);
  3272. g_call_system_proc(list,pd,nil);
  3273. cgpara3.done;
  3274. cgpara2.done;
  3275. cgpara1.done;
  3276. getmemres.resetiftemp;
  3277. end;
  3278. procedure thlcgobj.g_releasevaluepara_openarray(list: TAsmList; arrdef: tarraydef; const l: tlocation);
  3279. var
  3280. cgpara1 : TCGPara;
  3281. pd : tprocdef;
  3282. begin
  3283. { do freemem call }
  3284. pd:=search_system_proc('fpc_freemem');
  3285. cgpara1.init;
  3286. paramanager.getintparaloc(pd,1,cgpara1);
  3287. { load source }
  3288. a_load_loc_cgpara(list,getpointerdef(arrdef),l,cgpara1);
  3289. paramanager.freecgpara(list,cgpara1);
  3290. g_call_system_proc(list,pd,nil);
  3291. cgpara1.done;
  3292. end;
  3293. procedure thlcgobj.g_profilecode(list: TAsmList);
  3294. begin
  3295. end;
  3296. procedure thlcgobj.g_allocload_reg_reg(list: TAsmList; regsize: tdef; const fromreg: tregister; out toreg: tregister; regtyp: tregistertype);
  3297. begin
  3298. case regtyp of
  3299. R_INTREGISTER:
  3300. toreg:=getintregister(list,regsize);
  3301. R_ADDRESSREGISTER:
  3302. toreg:=getaddressregister(list,regsize);
  3303. R_FPUREGISTER:
  3304. toreg:=getfpuregister(list,regsize);
  3305. else
  3306. internalerror(2013112910);
  3307. end;
  3308. a_load_reg_reg(list,regsize,regsize,fromreg,toreg);
  3309. end;
  3310. procedure thlcgobj.g_reference_loc(list: TAsmList; def: tdef; const fromloc: tlocation; out toloc: tlocation);
  3311. procedure handle_reg_move(regsize: tdef; const fromreg: tregister; out toreg: tregister; regtyp: tregistertype);
  3312. begin
  3313. case regtyp of
  3314. R_INTREGISTER:
  3315. toreg:=getintregister(list,regsize);
  3316. R_ADDRESSREGISTER:
  3317. toreg:=getaddressregister(list,regsize);
  3318. R_FPUREGISTER:
  3319. toreg:=getfpuregister(list,regsize);
  3320. else
  3321. internalerror(2013112915);
  3322. end;
  3323. a_load_reg_reg(list,regsize,regsize,fromreg,toreg);
  3324. end;
  3325. begin
  3326. toloc:=fromloc;
  3327. case fromloc.loc of
  3328. { volatile location, can't get a permanent reference }
  3329. LOC_REGISTER,
  3330. LOC_FPUREGISTER:
  3331. internalerror(2012012702);
  3332. LOC_CONSTANT:
  3333. { finished }
  3334. ;
  3335. LOC_CREGISTER:
  3336. handle_reg_move(def,fromloc.reference.index,toloc.reference.index,R_INTREGISTER);
  3337. LOC_CFPUREGISTER:
  3338. handle_reg_move(def,fromloc.reference.index,toloc.reference.index,R_FPUREGISTER);
  3339. { although LOC_CREFERENCE cannot be an lvalue, we may want to take a
  3340. reference to such a location for multiple reading }
  3341. LOC_CREFERENCE,
  3342. LOC_REFERENCE:
  3343. begin
  3344. if (fromloc.reference.base<>NR_NO) and
  3345. (fromloc.reference.base<>current_procinfo.framepointer) and
  3346. (fromloc.reference.base<>NR_STACK_POINTER_REG) then
  3347. handle_reg_move(voidpointertype,fromloc.reference.base,toloc.reference.base,getregtype(fromloc.reference.base));
  3348. if (fromloc.reference.index<>NR_NO) and
  3349. (fromloc.reference.index<>current_procinfo.framepointer) and
  3350. (fromloc.reference.index<>NR_STACK_POINTER_REG) then
  3351. handle_reg_move(voidpointertype,fromloc.reference.index,toloc.reference.index,getregtype(fromloc.reference.index));
  3352. end;
  3353. else
  3354. internalerror(2012012701);
  3355. end;
  3356. end;
  3357. procedure thlcgobj.location_force_reg(list: TAsmList; var l: tlocation; src_size, dst_size: tdef; maybeconst: boolean);
  3358. var
  3359. hregister,
  3360. hregister2: tregister;
  3361. hl : tasmlabel;
  3362. oldloc : tlocation;
  3363. begin
  3364. oldloc:=l;
  3365. hregister:=getregisterfordef(list,dst_size);
  3366. { load value in new register }
  3367. case l.loc of
  3368. {$ifdef cpuflags}
  3369. LOC_FLAGS :
  3370. begin
  3371. g_flags2reg(list,dst_size,l.resflags,hregister);
  3372. cg.a_reg_dealloc(list,NR_DEFAULTFLAGS);
  3373. end;
  3374. {$endif cpuflags}
  3375. LOC_JUMP :
  3376. begin
  3377. a_label(list,current_procinfo.CurrTrueLabel);
  3378. a_load_const_reg(list,dst_size,1,hregister);
  3379. current_asmdata.getjumplabel(hl);
  3380. a_jmp_always(list,hl);
  3381. a_label(list,current_procinfo.CurrFalseLabel);
  3382. a_load_const_reg(list,dst_size,0,hregister);
  3383. a_label(list,hl);
  3384. end;
  3385. else
  3386. begin
  3387. { load_loc_reg can only handle size >= l.size, when the
  3388. new size is smaller then we need to adjust the size
  3389. of the orignal and maybe recalculate l.register for i386 }
  3390. if (dst_size.size<src_size.size) then
  3391. begin
  3392. hregister2:=getregisterfordef(list,src_size);
  3393. { prevent problems with memory locations -- at this high
  3394. level we cannot twiddle with the reference offset, since
  3395. that may not mean anything (e.g., it refers to fixed-sized
  3396. stack slots on Java) }
  3397. a_load_loc_reg(list,src_size,src_size,l,hregister2);
  3398. a_load_reg_reg(list,src_size,dst_size,hregister2,hregister);
  3399. end
  3400. else
  3401. a_load_loc_reg(list,src_size,dst_size,l,hregister);
  3402. end;
  3403. end;
  3404. if (l.loc <> LOC_CREGISTER) or
  3405. not maybeconst then
  3406. location_reset(l,LOC_REGISTER,def_cgsize(dst_size))
  3407. else
  3408. location_reset(l,LOC_CREGISTER,def_cgsize(dst_size));
  3409. l.register:=hregister;
  3410. { Release temp if it was a reference }
  3411. if oldloc.loc=LOC_REFERENCE then
  3412. location_freetemp(list,oldloc);
  3413. end;
  3414. procedure thlcgobj.location_force_fpureg(list: TAsmList; var l: tlocation; size: tdef; maybeconst: boolean);
  3415. var
  3416. reg : tregister;
  3417. begin
  3418. if (l.loc<>LOC_FPUREGISTER) and
  3419. ((l.loc<>LOC_CFPUREGISTER) or (not maybeconst)) then
  3420. begin
  3421. { if it's in an mm register, store to memory first }
  3422. if (l.loc in [LOC_MMREGISTER,LOC_CMMREGISTER]) then
  3423. location_force_mem(list,l,size);
  3424. reg:=getfpuregister(list,size);
  3425. a_loadfpu_loc_reg(list,size,size,l,reg);
  3426. location_freetemp(list,l);
  3427. location_reset(l,LOC_FPUREGISTER,l.size);
  3428. l.register:=reg;
  3429. end;
  3430. end;
  3431. procedure thlcgobj.location_force_mem(list: TAsmList; var l: tlocation; size: tdef);
  3432. var
  3433. r : treference;
  3434. forcesize: aint;
  3435. begin
  3436. case l.loc of
  3437. LOC_FPUREGISTER,
  3438. LOC_CFPUREGISTER :
  3439. begin
  3440. tg.gethltemp(list,size,size.size,tt_normal,r);
  3441. a_loadfpu_reg_ref(list,size,size,l.register,r);
  3442. location_reset_ref(l,LOC_REFERENCE,l.size,0);
  3443. l.reference:=r;
  3444. end;
  3445. LOC_MMREGISTER,
  3446. LOC_CMMREGISTER:
  3447. begin
  3448. { vectors can't be represented yet using tdef }
  3449. if size.typ<>floatdef then
  3450. internalerror(2012062301);
  3451. tg.gethltemp(list,size,size.size,tt_normal,r);
  3452. a_loadmm_reg_ref(list,size,size,l.register,r,mms_movescalar);
  3453. location_reset_ref(l,LOC_REFERENCE,l.size,0);
  3454. l.reference:=r;
  3455. end;
  3456. LOC_CONSTANT,
  3457. LOC_REGISTER,
  3458. LOC_CREGISTER,
  3459. LOC_SUBSETREG,
  3460. LOC_CSUBSETREG,
  3461. LOC_SUBSETREF,
  3462. LOC_CSUBSETREF:
  3463. begin
  3464. if not is_dynamic_array(size) and
  3465. not is_open_array(size) then
  3466. forcesize:=size.size
  3467. else
  3468. forcesize:=sizeof(pint);
  3469. tg.gethltemp(list,size,forcesize,tt_normal,r);
  3470. a_load_loc_ref(list,size,size,l,r);
  3471. location_reset_ref(l,LOC_REFERENCE,l.size,0);
  3472. l.reference:=r;
  3473. end;
  3474. LOC_CREFERENCE,
  3475. LOC_REFERENCE : ;
  3476. else
  3477. internalerror(2011010304);
  3478. end;
  3479. end;
  3480. procedure thlcgobj.location_force_mmregscalar(list: TAsmList; var l: tlocation; size: tdef; maybeconst: boolean);
  3481. var
  3482. reg : tregister;
  3483. href : treference;
  3484. newsize : tdef;
  3485. begin
  3486. if (l.loc<>LOC_MMREGISTER) and
  3487. ((l.loc<>LOC_CMMREGISTER) or (not maybeconst)) then
  3488. begin
  3489. { if it's in an fpu register, store to memory first }
  3490. if (l.loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER]) then
  3491. begin
  3492. tg.gethltemp(list,size,-1,tt_normal,href);
  3493. hlcg.a_loadfpu_reg_ref(list,size,size,l.register,href);
  3494. location_reset_ref(l,LOC_REFERENCE,l.size,0);
  3495. l.reference:=href;
  3496. end;
  3497. { on ARM, CFP values may be located in integer registers,
  3498. and its second_int_to_real() also uses this routine to
  3499. force integer (memory) values in an mmregister }
  3500. if (l.size in [OS_32,OS_S32]) then
  3501. begin
  3502. size:=cgsize_orddef(l.size);
  3503. newsize:=s32floattype;
  3504. end
  3505. else if (l.size in [OS_64,OS_S64]) then
  3506. begin
  3507. size:=cgsize_orddef(l.size);
  3508. newsize:=s64floattype;
  3509. end
  3510. else
  3511. newsize:=size;
  3512. case size.size of
  3513. 4:
  3514. newsize:=s32floattype;
  3515. 8:
  3516. newsize:=s64floattype;
  3517. else
  3518. newsize:=size;
  3519. end;
  3520. reg:=hlcg.getmmregister(list,newsize);
  3521. hlcg.a_loadmm_loc_reg(list,size,newsize,l,reg,mms_movescalar);
  3522. l.size:=def_cgsize(newsize);
  3523. location_freetemp(list,l);
  3524. location_reset(l,LOC_MMREGISTER,l.size);
  3525. l.register:=reg;
  3526. end;
  3527. end;
  3528. procedure thlcgobj.location_get_data_ref(list: TAsmList; def: tdef; const l: tlocation; var ref: treference; loadref: boolean; alignment: longint);
  3529. begin
  3530. case l.loc of
  3531. LOC_REGISTER,
  3532. LOC_CREGISTER :
  3533. begin
  3534. if not loadref then
  3535. internalerror(200410231);
  3536. reference_reset_base(ref,voidpointertype,l.register,0,alignment);
  3537. end;
  3538. LOC_REFERENCE,
  3539. LOC_CREFERENCE :
  3540. begin
  3541. if loadref then
  3542. begin
  3543. reference_reset_base(ref,voidpointertype,getaddressregister(list,voidpointertype),0,alignment);
  3544. { it's a pointer to def }
  3545. a_load_ref_reg(list,voidpointertype,voidpointertype,l.reference,ref.base);
  3546. end
  3547. else
  3548. ref:=l.reference;
  3549. end;
  3550. else
  3551. internalerror(200309181);
  3552. end;
  3553. end;
  3554. procedure thlcgobj.maketojumpbool(list: TAsmList; p: tnode);
  3555. {
  3556. produces jumps to true respectively false labels using boolean expressions
  3557. depending on whether the loading of regvars is currently being
  3558. synchronized manually (such as in an if-node) or automatically (most of
  3559. the other cases where this procedure is called), loadregvars can be
  3560. "lr_load_regvars" or "lr_dont_load_regvars"
  3561. }
  3562. var
  3563. storepos : tfileposinfo;
  3564. begin
  3565. if nf_error in p.flags then
  3566. exit;
  3567. storepos:=current_filepos;
  3568. current_filepos:=p.fileinfo;
  3569. if is_boolean(p.resultdef) then
  3570. begin
  3571. if is_constboolnode(p) then
  3572. begin
  3573. if Tordconstnode(p).value.uvalue<>0 then
  3574. a_jmp_always(list,current_procinfo.CurrTrueLabel)
  3575. else
  3576. a_jmp_always(list,current_procinfo.CurrFalseLabel)
  3577. end
  3578. else
  3579. begin
  3580. case p.location.loc of
  3581. LOC_SUBSETREG,LOC_CSUBSETREG,
  3582. LOC_SUBSETREF,LOC_CSUBSETREF,
  3583. LOC_CREGISTER,LOC_REGISTER,LOC_CREFERENCE,LOC_REFERENCE :
  3584. begin
  3585. a_cmp_const_loc_label(list,p.resultdef,OC_NE,0,p.location,current_procinfo.CurrTrueLabel);
  3586. a_jmp_always(list,current_procinfo.CurrFalseLabel);
  3587. end;
  3588. LOC_JUMP:
  3589. ;
  3590. {$ifdef cpuflags}
  3591. LOC_FLAGS :
  3592. begin
  3593. a_jmp_flags(list,p.location.resflags,current_procinfo.CurrTrueLabel);
  3594. a_reg_dealloc(list,NR_DEFAULTFLAGS);
  3595. a_jmp_always(list,current_procinfo.CurrFalseLabel);
  3596. end;
  3597. {$endif cpuflags}
  3598. else
  3599. begin
  3600. printnode(output,p);
  3601. internalerror(2011010418);
  3602. end;
  3603. end;
  3604. end;
  3605. end
  3606. else
  3607. internalerror(2011010419);
  3608. current_filepos:=storepos;
  3609. end;
  3610. procedure thlcgobj.maybe_change_load_node_reg(list: TAsmList; var n: tnode; reload: boolean);
  3611. var
  3612. rr: treplaceregrec;
  3613. varloc : tai_varloc;
  3614. begin
  3615. if not (n.location.loc in [LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMXREGISTER,LOC_CMMREGISTER]) or
  3616. ([fc_inflowcontrol,fc_gotolabel,fc_lefthandled] * flowcontrol <> []) then
  3617. exit;
  3618. rr.old := n.location.register;
  3619. rr.ressym := nil;
  3620. rr.sym := nil;
  3621. rr.oldhi := NR_NO;
  3622. case n.location.loc of
  3623. LOC_CREGISTER:
  3624. begin
  3625. {$ifdef cpu64bitalu}
  3626. if (n.location.size in [OS_128,OS_S128]) then
  3627. begin
  3628. rr.oldhi := n.location.register128.reghi;
  3629. rr.new := cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
  3630. rr.newhi := cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
  3631. end
  3632. else
  3633. {$else cpu64bitalu}
  3634. if (n.location.size in [OS_64,OS_S64]) then
  3635. begin
  3636. rr.oldhi := n.location.register64.reghi;
  3637. rr.new := cg.getintregister(current_asmdata.CurrAsmList,OS_32);
  3638. rr.newhi := cg.getintregister(current_asmdata.CurrAsmList,OS_32);
  3639. end
  3640. else
  3641. {$endif cpu64bitalu}
  3642. rr.new := cg.getintregister(current_asmdata.CurrAsmList,n.location.size);
  3643. end;
  3644. LOC_CFPUREGISTER:
  3645. rr.new := cg.getfpuregister(current_asmdata.CurrAsmList,n.location.size);
  3646. {$ifdef SUPPORT_MMX}
  3647. LOC_CMMXREGISTER:
  3648. rr.new := tcgx86(cg).getmmxregister(current_asmdata.CurrAsmList);
  3649. {$endif SUPPORT_MMX}
  3650. LOC_CMMREGISTER:
  3651. rr.new := cg.getmmregister(current_asmdata.CurrAsmList,n.location.size);
  3652. else
  3653. exit;
  3654. end;
  3655. { self is implicitly returned from constructors, even if there are no
  3656. references to it; additionally, funcretsym is not set for constructor
  3657. procdefs }
  3658. if (current_procinfo.procdef.proctypeoption=potype_constructor) then
  3659. rr.ressym:=tsym(current_procinfo.procdef.parast.Find('self'))
  3660. else if not is_void(current_procinfo.procdef.returndef) and
  3661. assigned(current_procinfo.procdef.funcretsym) and
  3662. (tabstractvarsym(current_procinfo.procdef.funcretsym).refs <> 0) then
  3663. rr.ressym:=current_procinfo.procdef.funcretsym;
  3664. if not foreachnode(n,@do_replace_node_regs,@rr) then
  3665. exit;
  3666. if reload then
  3667. case n.location.loc of
  3668. LOC_CREGISTER:
  3669. begin
  3670. {$ifdef cpu64bitalu}
  3671. if (n.location.size in [OS_128,OS_S128]) then
  3672. cg128.a_load128_reg_reg(list,n.location.register128,joinreg128(rr.new,rr.newhi))
  3673. else
  3674. {$else cpu64bitalu}
  3675. if (n.location.size in [OS_64,OS_S64]) then
  3676. cg64.a_load64_reg_reg(list,n.location.register64,joinreg64(rr.new,rr.newhi))
  3677. else
  3678. {$endif cpu64bitalu}
  3679. cg.a_load_reg_reg(list,n.location.size,n.location.size,n.location.register,rr.new);
  3680. end;
  3681. LOC_CFPUREGISTER:
  3682. cg.a_loadfpu_reg_reg(list,n.location.size,n.location.size,n.location.register,rr.new);
  3683. {$ifdef SUPPORT_MMX}
  3684. LOC_CMMXREGISTER:
  3685. cg.a_loadmm_reg_reg(list,OS_M64,OS_M64,n.location.register,rr.new,nil);
  3686. {$endif SUPPORT_MMX}
  3687. LOC_CMMREGISTER:
  3688. cg.a_loadmm_reg_reg(list,n.location.size,n.location.size,n.location.register,rr.new,nil);
  3689. else
  3690. internalerror(2006090920);
  3691. end;
  3692. { now that we've change the loadn/temp, also change the node result location }
  3693. {$ifdef cpu64bitalu}
  3694. if (n.location.size in [OS_128,OS_S128]) then
  3695. begin
  3696. n.location.register128.reglo := rr.new;
  3697. n.location.register128.reghi := rr.newhi;
  3698. if assigned(rr.sym) and
  3699. ((rr.sym.currentregloc.register<>rr.new) or
  3700. (rr.sym.currentregloc.registerhi<>rr.newhi)) then
  3701. begin
  3702. varloc:=tai_varloc.create128(rr.sym,rr.new,rr.newhi);
  3703. varloc.oldlocation:=rr.sym.currentregloc.register;
  3704. varloc.oldlocationhi:=rr.sym.currentregloc.registerhi;
  3705. rr.sym.currentregloc.register:=rr.new;
  3706. rr.sym.currentregloc.registerHI:=rr.newhi;
  3707. list.concat(varloc);
  3708. end;
  3709. end
  3710. else
  3711. {$else cpu64bitalu}
  3712. if (n.location.size in [OS_64,OS_S64]) then
  3713. begin
  3714. n.location.register64.reglo := rr.new;
  3715. n.location.register64.reghi := rr.newhi;
  3716. if assigned(rr.sym) and
  3717. ((rr.sym.currentregloc.register<>rr.new) or
  3718. (rr.sym.currentregloc.registerhi<>rr.newhi)) then
  3719. begin
  3720. varloc:=tai_varloc.create64(rr.sym,rr.new,rr.newhi);
  3721. varloc.oldlocation:=rr.sym.currentregloc.register;
  3722. varloc.oldlocationhi:=rr.sym.currentregloc.registerhi;
  3723. rr.sym.currentregloc.register:=rr.new;
  3724. rr.sym.currentregloc.registerHI:=rr.newhi;
  3725. list.concat(varloc);
  3726. end;
  3727. end
  3728. else
  3729. {$endif cpu64bitalu}
  3730. begin
  3731. n.location.register := rr.new;
  3732. if assigned(rr.sym) and (rr.sym.currentregloc.register<>rr.new) then
  3733. begin
  3734. varloc:=tai_varloc.create(rr.sym,rr.new);
  3735. varloc.oldlocation:=rr.sym.currentregloc.register;
  3736. rr.sym.currentregloc.register:=rr.new;
  3737. list.concat(varloc);
  3738. end;
  3739. end;
  3740. end;
  3741. function thlcgobj.do_replace_node_regs(var n: tnode; para: pointer): foreachnoderesult;
  3742. var
  3743. rr: preplaceregrec absolute para;
  3744. begin
  3745. result := fen_false;
  3746. if (nf_is_funcret in n.flags) and (fc_exit in flowcontrol) then
  3747. exit;
  3748. case n.nodetype of
  3749. loadn:
  3750. begin
  3751. if (tloadnode(n).symtableentry.typ in [localvarsym,paravarsym,staticvarsym]) and
  3752. (tabstractvarsym(tloadnode(n).symtableentry).varoptions * [vo_is_dll_var, vo_is_thread_var] = []) and
  3753. not assigned(tloadnode(n).left) and
  3754. ((tloadnode(n).symtableentry <> rr^.ressym) or
  3755. not(fc_exit in flowcontrol)
  3756. ) and
  3757. (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.loc in [LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMXREGISTER,LOC_CMMREGISTER]) and
  3758. (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.register = rr^.old) then
  3759. begin
  3760. {$ifdef cpu64bitalu}
  3761. { it's possible a 128 bit location was shifted and/xor typecasted }
  3762. { in a 64 bit value, so only 1 register was left in the location }
  3763. if (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.size in [OS_128,OS_S128]) then
  3764. if (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.register128.reghi = rr^.oldhi) then
  3765. tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.register128.reghi := rr^.newhi
  3766. else
  3767. exit;
  3768. {$else cpu64bitalu}
  3769. { it's possible a 64 bit location was shifted and/xor typecasted }
  3770. { in a 32 bit value, so only 1 register was left in the location }
  3771. if (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.size in [OS_64,OS_S64]) then
  3772. if (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.register64.reghi = rr^.oldhi) then
  3773. tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.register64.reghi := rr^.newhi
  3774. else
  3775. exit;
  3776. {$endif cpu64bitalu}
  3777. tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.register := rr^.new;
  3778. rr^.sym := tabstractnormalvarsym(tloadnode(n).symtableentry);
  3779. result := fen_norecurse_true;
  3780. end;
  3781. end;
  3782. temprefn:
  3783. begin
  3784. if (ti_valid in ttemprefnode(n).tempinfo^.flags) and
  3785. (ttemprefnode(n).tempinfo^.location.loc in [LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMXREGISTER,LOC_CMMREGISTER]) and
  3786. (ttemprefnode(n).tempinfo^.location.register = rr^.old) then
  3787. begin
  3788. {$ifdef cpu64bitalu}
  3789. { it's possible a 128 bit location was shifted and/xor typecasted }
  3790. { in a 64 bit value, so only 1 register was left in the location }
  3791. if (ttemprefnode(n).tempinfo^.location.size in [OS_128,OS_S128]) then
  3792. if (ttemprefnode(n).tempinfo^.location.register128.reghi = rr^.oldhi) then
  3793. ttemprefnode(n).tempinfo^.location.register128.reghi := rr^.newhi
  3794. else
  3795. exit;
  3796. {$else cpu64bitalu}
  3797. { it's possible a 64 bit location was shifted and/xor typecasted }
  3798. { in a 32 bit value, so only 1 register was left in the location }
  3799. if (ttemprefnode(n).tempinfo^.location.size in [OS_64,OS_S64]) then
  3800. if (ttemprefnode(n).tempinfo^.location.register64.reghi = rr^.oldhi) then
  3801. ttemprefnode(n).tempinfo^.location.register64.reghi := rr^.newhi
  3802. else
  3803. exit;
  3804. {$endif cpu64bitalu}
  3805. ttemprefnode(n).tempinfo^.location.register := rr^.new;
  3806. result := fen_norecurse_true;
  3807. end;
  3808. end;
  3809. { optimize the searching a bit }
  3810. derefn,addrn,
  3811. calln,inlinen,casen,
  3812. addn,subn,muln,
  3813. andn,orn,xorn,
  3814. ltn,lten,gtn,gten,equaln,unequaln,
  3815. slashn,divn,shrn,shln,notn,
  3816. inn,
  3817. asn,isn:
  3818. result := fen_norecurse_false;
  3819. end;
  3820. end;
  3821. procedure thlcgobj.gen_proc_symbol(list: TAsmList);
  3822. var
  3823. item,
  3824. previtem : TCmdStrListItem;
  3825. begin
  3826. previtem:=nil;
  3827. item := TCmdStrListItem(current_procinfo.procdef.aliasnames.first);
  3828. while assigned(item) do
  3829. begin
  3830. {$ifdef arm}
  3831. if GenerateThumbCode or GenerateThumb2Code then
  3832. list.concat(tai_thumb_func.create);
  3833. {$endif arm}
  3834. { "double link" all procedure entry symbols via .reference }
  3835. { directives on darwin, because otherwise the linker }
  3836. { sometimes strips the procedure if only on of the symbols }
  3837. { is referenced }
  3838. if assigned(previtem) and
  3839. (target_info.system in systems_darwin) then
  3840. list.concat(tai_directive.create(asd_reference,item.str));
  3841. if (cs_profile in current_settings.moduleswitches) or
  3842. (po_global in current_procinfo.procdef.procoptions) then
  3843. list.concat(Tai_symbol.createname_global(item.str,AT_FUNCTION,0))
  3844. else
  3845. list.concat(Tai_symbol.createname(item.str,AT_FUNCTION,0));
  3846. if assigned(previtem) and
  3847. (target_info.system in systems_darwin) then
  3848. list.concat(tai_directive.create(asd_reference,previtem.str));
  3849. if not(af_stabs_use_function_absolute_addresses in target_asm.flags) then
  3850. list.concat(Tai_function_name.create(item.str));
  3851. previtem:=item;
  3852. item := TCmdStrListItem(item.next);
  3853. end;
  3854. current_procinfo.procdef.procstarttai:=tai(list.last);
  3855. end;
  3856. procedure thlcgobj.gen_proc_symbol_end(list: TAsmList);
  3857. var
  3858. initname : tsymstr;
  3859. begin
  3860. list.concat(Tai_symbol_end.Createname(current_procinfo.procdef.mangledname));
  3861. current_procinfo.procdef.procendtai:=tai(list.last);
  3862. if (current_module.islibrary) then
  3863. if (current_procinfo.procdef.proctypeoption = potype_proginit) then
  3864. begin
  3865. { ToDo: systems that use indirect entry info, but check back with Windows! }
  3866. if target_info.system in systems_darwin then
  3867. { we need to call FPC_LIBMAIN in sysinit which in turn will call PascalMain }
  3868. initname:=target_info.cprefix+'FPC_LIBMAIN'
  3869. else
  3870. initname:=current_procinfo.procdef.mangledname;
  3871. { setinitname may generate a new section -> don't add to the
  3872. current list, because we assume this remains a text section }
  3873. exportlib.setinitname(current_asmdata.AsmLists[al_exports],initname);
  3874. end;
  3875. if (current_procinfo.procdef.proctypeoption=potype_proginit) then
  3876. begin
  3877. if (target_info.system in (systems_darwin+[system_powerpc_macos]+systems_aix)) and
  3878. not(current_module.islibrary) then
  3879. begin
  3880. new_section(list,sec_code,'',4);
  3881. list.concat(tai_symbol.createname_global(
  3882. target_info.cprefix+mainaliasname,AT_FUNCTION,0));
  3883. { keep argc, argv and envp properly on the stack }
  3884. if not(target_info.system in systems_aix) then
  3885. cg.a_jmp_name(list,target_info.cprefix+'FPC_SYSTEMMAIN')
  3886. else
  3887. cg.a_call_name(list,target_info.cprefix+'FPC_SYSTEMMAIN',false)
  3888. end;
  3889. end;
  3890. end;
  3891. procedure thlcgobj.gen_initialize_code(list: TAsmList);
  3892. begin
  3893. { initialize local data like ansistrings }
  3894. case current_procinfo.procdef.proctypeoption of
  3895. potype_unitinit:
  3896. begin
  3897. { this is also used for initialization of variables in a
  3898. program which does not have a globalsymtable }
  3899. if assigned(current_module.globalsymtable) then
  3900. TSymtable(current_module.globalsymtable).SymList.ForEachCall(@initialize_data,list);
  3901. TSymtable(current_module.localsymtable).SymList.ForEachCall(@initialize_data,list);
  3902. TSymtable(current_module.localsymtable).SymList.ForEachCall(@initialize_regvars,list);
  3903. end;
  3904. { units have seperate code for initilization and finalization }
  3905. potype_unitfinalize: ;
  3906. { program init/final is generated in separate procedure }
  3907. potype_proginit:
  3908. begin
  3909. TSymtable(current_module.localsymtable).SymList.ForEachCall(@initialize_regvars,list);
  3910. end;
  3911. else
  3912. current_procinfo.procdef.localst.SymList.ForEachCall(@initialize_data,list);
  3913. end;
  3914. { initialises temp. ansi/wide string data }
  3915. if (current_procinfo.procdef.proctypeoption<>potype_exceptfilter) then
  3916. inittempvariables(list);
  3917. {$ifdef OLDREGVARS}
  3918. load_regvars(list,nil);
  3919. {$endif OLDREGVARS}
  3920. end;
  3921. procedure thlcgobj.gen_finalize_code(list: TAsmList);
  3922. var
  3923. old_current_procinfo: tprocinfo;
  3924. begin
  3925. old_current_procinfo:=current_procinfo;
  3926. if (current_procinfo.procdef.proctypeoption=potype_exceptfilter) then
  3927. begin
  3928. if (current_procinfo.parent.finalize_procinfo<>current_procinfo) then
  3929. exit;
  3930. current_procinfo:=current_procinfo.parent;
  3931. end;
  3932. {$ifdef OLDREGVARS}
  3933. cleanup_regvars(list);
  3934. {$endif OLDREGVARS}
  3935. { finalize temporary data }
  3936. finalizetempvariables(list);
  3937. { finalize local data like ansistrings}
  3938. case current_procinfo.procdef.proctypeoption of
  3939. potype_unitfinalize:
  3940. begin
  3941. { this is also used for initialization of variables in a
  3942. program which does not have a globalsymtable }
  3943. if assigned(current_module.globalsymtable) then
  3944. TSymtable(current_module.globalsymtable).SymList.ForEachCall(@finalize_static_data,list);
  3945. TSymtable(current_module.localsymtable).SymList.ForEachCall(@finalize_static_data,list);
  3946. end;
  3947. { units/progs have separate code for initialization and finalization }
  3948. potype_unitinit: ;
  3949. { program init/final is generated in separate procedure }
  3950. potype_proginit: ;
  3951. else
  3952. current_procinfo.procdef.localst.SymList.ForEachCall(@finalize_local_vars,list);
  3953. end;
  3954. { finalize paras data }
  3955. if assigned(current_procinfo.procdef.parast) and
  3956. not(po_assembler in current_procinfo.procdef.procoptions) then
  3957. current_procinfo.procdef.parast.SymList.ForEachCall(@final_paras,list);
  3958. current_procinfo:=old_current_procinfo;
  3959. end;
  3960. procedure thlcgobj.gen_entry_code(list: TAsmList);
  3961. begin
  3962. { the actual profile code can clobber some registers,
  3963. therefore if the context must be saved, do it before
  3964. the actual call to the profile code
  3965. }
  3966. if (cs_profile in current_settings.moduleswitches) and
  3967. not(po_assembler in current_procinfo.procdef.procoptions) then
  3968. begin
  3969. { non-win32 can call mcout even in main }
  3970. if not (target_info.system in [system_i386_win32,system_i386_wdosx]) or
  3971. not (current_procinfo.procdef.proctypeoption=potype_proginit) then
  3972. begin
  3973. g_profilecode(list);
  3974. end;
  3975. end;
  3976. { TODO: create high level version (create compilerprocs in system unit,
  3977. look up procdef, use hlcgobj.a_call_name()) }
  3978. { call startup helpers from main program }
  3979. if (current_procinfo.procdef.proctypeoption=potype_proginit) then
  3980. begin
  3981. { initialize units }
  3982. cg.allocallcpuregisters(list);
  3983. if not(current_module.islibrary) then
  3984. cg.a_call_name(list,'FPC_INITIALIZEUNITS',false)
  3985. else
  3986. cg.a_call_name(list,'FPC_LIBINITIALIZEUNITS',false);
  3987. cg.deallocallcpuregisters(list);
  3988. end;
  3989. list.concat(Tai_force_line.Create);
  3990. {$ifdef OLDREGVARS}
  3991. load_regvars(list,nil);
  3992. {$endif OLDREGVARS}
  3993. end;
  3994. procedure thlcgobj.gen_exit_code(list: TAsmList);
  3995. begin
  3996. { TODO: create high level version (create compilerproc in system unit,
  3997. look up procdef, use hlcgobj.a_call_name()) }
  3998. { call __EXIT for main program }
  3999. if (not DLLsource) and
  4000. (current_procinfo.procdef.proctypeoption=potype_proginit) then
  4001. cg.a_call_name(list,'FPC_DO_EXIT',false);
  4002. end;
  4003. procedure thlcgobj.inittempvariables(list: TAsmList);
  4004. var
  4005. hp : ptemprecord;
  4006. href : treference;
  4007. begin
  4008. hp:=tg.templist;
  4009. while assigned(hp) do
  4010. begin
  4011. if assigned(hp^.def) and
  4012. is_managed_type(hp^.def) then
  4013. begin
  4014. reference_reset_base(href,voidstackpointertype,current_procinfo.framepointer,hp^.pos,voidstackpointertype.size);
  4015. g_initialize(list,hp^.def,href);
  4016. end;
  4017. hp:=hp^.next;
  4018. end;
  4019. end;
  4020. procedure thlcgobj.initialize_data(p: TObject; arg: pointer);
  4021. var
  4022. OldAsmList : TAsmList;
  4023. hp : tnode;
  4024. begin
  4025. if (tsym(p).typ = localvarsym) and
  4026. { local (procedure or unit) variables only need initialization if
  4027. they are used }
  4028. ((tabstractvarsym(p).refs>0) or
  4029. { managed return symbols must be inited }
  4030. ((tsym(p).typ=localvarsym) and (vo_is_funcret in tlocalvarsym(p).varoptions))
  4031. ) and
  4032. not(vo_is_typed_const in tabstractvarsym(p).varoptions) and
  4033. not(vo_is_external in tabstractvarsym(p).varoptions) and
  4034. not(vo_is_default_var in tabstractvarsym(p).varoptions) and
  4035. (is_managed_type(tabstractvarsym(p).vardef) or
  4036. ((m_iso in current_settings.modeswitches) and (tabstractvarsym(p).vardef.typ=filedef))
  4037. ) then
  4038. begin
  4039. OldAsmList:=current_asmdata.CurrAsmList;
  4040. current_asmdata.CurrAsmList:=TAsmList(arg);
  4041. hp:=cnodeutils.initialize_data_node(cloadnode.create(tsym(p),tsym(p).owner),false);
  4042. firstpass(hp);
  4043. secondpass(hp);
  4044. hp.free;
  4045. current_asmdata.CurrAsmList:=OldAsmList;
  4046. end;
  4047. end;
  4048. procedure thlcgobj.finalizetempvariables(list: TAsmList);
  4049. var
  4050. hp : ptemprecord;
  4051. href : treference;
  4052. begin
  4053. hp:=tg.templist;
  4054. while assigned(hp) do
  4055. begin
  4056. if assigned(hp^.def) and
  4057. is_managed_type(hp^.def) then
  4058. begin
  4059. include(current_procinfo.flags,pi_needs_implicit_finally);
  4060. reference_reset_base(href,voidstackpointertype,current_procinfo.framepointer,hp^.pos,voidstackpointertype.size);
  4061. g_finalize(list,hp^.def,href);
  4062. end;
  4063. hp:=hp^.next;
  4064. end;
  4065. end;
  4066. procedure thlcgobj.initialize_regvars(p: TObject; arg: pointer);
  4067. var
  4068. href : treference;
  4069. begin
  4070. if (tsym(p).typ=staticvarsym) then
  4071. begin
  4072. { Static variables can have the initialloc only set to LOC_CxREGISTER
  4073. or LOC_INVALID, for explaination see gen_alloc_symtable (PFV) }
  4074. case tstaticvarsym(p).initialloc.loc of
  4075. LOC_CREGISTER :
  4076. begin
  4077. {$ifdef cpu64bitalu}
  4078. if (tstaticvarsym(p).initialloc.size in [OS_128,OS_S128]) then
  4079. cg128.a_load128_const_reg(TAsmList(arg),0,0,tstaticvarsym(p).initialloc.register128)
  4080. else
  4081. {$else cpu64bitalu}
  4082. if (tstaticvarsym(p).initialloc.size in [OS_64,OS_S64]) then
  4083. cg64.a_load64_const_reg(TAsmList(arg),0,tstaticvarsym(p).initialloc.register64)
  4084. else
  4085. {$endif cpu64bitalu}
  4086. a_load_const_reg(TAsmList(arg),tstaticvarsym(p).vardef,0,
  4087. tstaticvarsym(p).initialloc.register);
  4088. end;
  4089. LOC_CMMREGISTER :
  4090. { clear the whole register }
  4091. a_opmm_reg_reg(TAsmList(arg),OP_XOR,tstaticvarsym(p).vardef,
  4092. tstaticvarsym(p).initialloc.register,
  4093. tstaticvarsym(p).initialloc.register,
  4094. nil);
  4095. LOC_CFPUREGISTER :
  4096. begin
  4097. { initialize fpu regvar by loading from memory }
  4098. reference_reset_symbol(href,
  4099. current_asmdata.RefAsmSymbol(tstaticvarsym(p).mangledname), 0,
  4100. var_align(tstaticvarsym(p).vardef.alignment));
  4101. a_loadfpu_ref_reg(TAsmList(arg), tstaticvarsym(p).vardef,
  4102. tstaticvarsym(p).vardef, href, tstaticvarsym(p).initialloc.register);
  4103. end;
  4104. LOC_INVALID :
  4105. ;
  4106. else
  4107. internalerror(200410124);
  4108. end;
  4109. end;
  4110. end;
  4111. procedure thlcgobj.finalize_sym(asmlist: TAsmList; sym: tsym);
  4112. var
  4113. hp : tnode;
  4114. OldAsmList : TAsmList;
  4115. begin
  4116. include(current_procinfo.flags,pi_needs_implicit_finally);
  4117. OldAsmList:=current_asmdata.CurrAsmList;
  4118. current_asmdata.CurrAsmList:=asmlist;
  4119. hp:=cloadnode.create(sym,sym.owner);
  4120. if (sym.typ=staticvarsym) and (vo_force_finalize in tstaticvarsym(sym).varoptions) then
  4121. include(tloadnode(hp).loadnodeflags,loadnf_isinternal_ignoreconst);
  4122. hp:=cnodeutils.finalize_data_node(hp);
  4123. firstpass(hp);
  4124. secondpass(hp);
  4125. hp.free;
  4126. current_asmdata.CurrAsmList:=OldAsmList;
  4127. end;
  4128. procedure thlcgobj.finalize_local_vars(p: TObject; arg: pointer);
  4129. begin
  4130. if (tsym(p).typ=localvarsym) and
  4131. (tlocalvarsym(p).refs>0) and
  4132. not(vo_is_external in tlocalvarsym(p).varoptions) and
  4133. not(vo_is_funcret in tlocalvarsym(p).varoptions) and
  4134. not(vo_is_default_var in tabstractvarsym(p).varoptions) and
  4135. is_managed_type(tlocalvarsym(p).vardef) then
  4136. finalize_sym(TAsmList(arg),tsym(p));
  4137. end;
  4138. procedure thlcgobj.finalize_static_data(p: TObject; arg: pointer);
  4139. var
  4140. i : longint;
  4141. pd : tprocdef;
  4142. begin
  4143. case tsym(p).typ of
  4144. staticvarsym :
  4145. begin
  4146. { local (procedure or unit) variables only need finalization
  4147. if they are used
  4148. }
  4149. if ((tstaticvarsym(p).refs>0) or
  4150. { global (unit) variables always need finalization, since
  4151. they may also be used in another unit
  4152. }
  4153. (tstaticvarsym(p).owner.symtabletype=globalsymtable)) and
  4154. (
  4155. (tstaticvarsym(p).varspez<>vs_const) or
  4156. (vo_force_finalize in tstaticvarsym(p).varoptions)
  4157. ) and
  4158. not(vo_is_funcret in tstaticvarsym(p).varoptions) and
  4159. not(vo_is_external in tstaticvarsym(p).varoptions) and
  4160. is_managed_type(tstaticvarsym(p).vardef) and
  4161. not (
  4162. assigned(tstaticvarsym(p).fieldvarsym) and
  4163. assigned(tstaticvarsym(p).fieldvarsym.owner.defowner) and
  4164. (df_generic in tdef(tstaticvarsym(p).fieldvarsym.owner.defowner).defoptions)
  4165. )
  4166. then
  4167. finalize_sym(TAsmList(arg),tsym(p));
  4168. end;
  4169. procsym :
  4170. begin
  4171. for i:=0 to tprocsym(p).ProcdefList.Count-1 do
  4172. begin
  4173. pd:=tprocdef(tprocsym(p).ProcdefList[i]);
  4174. if assigned(pd.localst) and
  4175. (pd.procsym=tprocsym(p)) and
  4176. (pd.localst.symtabletype<>staticsymtable) then
  4177. pd.localst.SymList.ForEachCall(@finalize_static_data,arg);
  4178. end;
  4179. end;
  4180. end;
  4181. end;
  4182. procedure thlcgobj.final_paras(p: TObject; arg: pointer);
  4183. var
  4184. list : TAsmList;
  4185. href : treference;
  4186. hsym : tparavarsym;
  4187. eldef : tdef;
  4188. highloc : tlocation;
  4189. begin
  4190. if not(tsym(p).typ=paravarsym) then
  4191. exit;
  4192. list:=TAsmList(arg);
  4193. if is_managed_type(tparavarsym(p).vardef) then
  4194. begin
  4195. if (tparavarsym(p).varspez=vs_value) then
  4196. begin
  4197. include(current_procinfo.flags,pi_needs_implicit_finally);
  4198. location_get_data_ref(list,tparavarsym(p).vardef,tparavarsym(p).localloc,href,is_open_array(tparavarsym(p).vardef),sizeof(pint));
  4199. if is_open_array(tparavarsym(p).vardef) then
  4200. begin
  4201. if paramanager.push_high_param(tparavarsym(p).varspez,tparavarsym(p).vardef,current_procinfo.procdef.proccalloption) then
  4202. begin
  4203. hsym:=tparavarsym(get_high_value_sym(tparavarsym(p)));
  4204. if not assigned(hsym) then
  4205. internalerror(201003032);
  4206. highloc:=hsym.initialloc
  4207. end
  4208. else
  4209. highloc.loc:=LOC_INVALID;
  4210. eldef:=tarraydef(tparavarsym(p).vardef).elementdef;
  4211. g_array_rtti_helper(list,eldef,href,highloc,'fpc_finalize_array');
  4212. end
  4213. else
  4214. g_finalize(list,tparavarsym(p).vardef,href);
  4215. end;
  4216. end;
  4217. { open arrays can contain elements requiring init/final code, so the else has been removed here }
  4218. if (tparavarsym(p).varspez=vs_value) and
  4219. (is_open_array(tparavarsym(p).vardef) or
  4220. is_array_of_const(tparavarsym(p).vardef)) then
  4221. begin
  4222. { cdecl functions don't have a high pointer so it is not possible to generate
  4223. a local copy }
  4224. if not(current_procinfo.procdef.proccalloption in cdecl_pocalls) then
  4225. g_releasevaluepara_openarray(list,tarraydef(tparavarsym(p).vardef),tparavarsym(p).localloc);
  4226. end;
  4227. end;
  4228. { generates the code for incrementing the reference count of parameters and
  4229. initialize out parameters }
  4230. { generates the code for incrementing the reference count of parameters and
  4231. initialize out parameters }
  4232. procedure thlcgobj.init_paras(p:TObject;arg:pointer);
  4233. var
  4234. href : treference;
  4235. hsym : tparavarsym;
  4236. eldef : tdef;
  4237. list : TAsmList;
  4238. highloc : tlocation;
  4239. needs_inittable : boolean;
  4240. begin
  4241. list:=TAsmList(arg);
  4242. if (tsym(p).typ=paravarsym) then
  4243. begin
  4244. needs_inittable:=is_managed_type(tparavarsym(p).vardef);
  4245. case tparavarsym(p).varspez of
  4246. vs_value :
  4247. if needs_inittable then
  4248. begin
  4249. { variants are already handled by the call to fpc_variant_copy_overwrite if
  4250. they are passed by reference }
  4251. if not((tparavarsym(p).vardef.typ=variantdef) and
  4252. paramanager.push_addr_param(tparavarsym(p).varspez,tparavarsym(p).vardef,current_procinfo.procdef.proccalloption)) then
  4253. begin
  4254. location_get_data_ref(list,tparavarsym(p).vardef,tparavarsym(p).initialloc,href,is_open_array(tparavarsym(p).vardef),sizeof(pint));
  4255. if is_open_array(tparavarsym(p).vardef) then
  4256. begin
  4257. if paramanager.push_high_param(tparavarsym(p).varspez,tparavarsym(p).vardef,current_procinfo.procdef.proccalloption) then
  4258. begin
  4259. hsym:=tparavarsym(get_high_value_sym(tparavarsym(p)));
  4260. if not assigned(hsym) then
  4261. internalerror(201003032);
  4262. highloc:=hsym.initialloc
  4263. end
  4264. else
  4265. highloc.loc:=LOC_INVALID;
  4266. { open arrays do not contain correct element count in their rtti,
  4267. the actual count must be passed separately. }
  4268. eldef:=tarraydef(tparavarsym(p).vardef).elementdef;
  4269. g_array_rtti_helper(list,eldef,href,highloc,'fpc_addref_array');
  4270. end
  4271. else
  4272. g_incrrefcount(list,tparavarsym(p).vardef,href);
  4273. end;
  4274. end;
  4275. vs_out :
  4276. begin
  4277. if needs_inittable then
  4278. begin
  4279. { we have no idea about the alignment at the callee side,
  4280. and the user also cannot specify "unaligned" here, so
  4281. assume worst case }
  4282. location_get_data_ref(list,tparavarsym(p).vardef,tparavarsym(p).initialloc,href,true,1);
  4283. if needs_inittable then
  4284. begin
  4285. if is_open_array(tparavarsym(p).vardef) then
  4286. begin
  4287. if paramanager.push_high_param(tparavarsym(p).varspez,tparavarsym(p).vardef,current_procinfo.procdef.proccalloption) then
  4288. begin
  4289. hsym:=tparavarsym(get_high_value_sym(tparavarsym(p)));
  4290. if not assigned(hsym) then
  4291. internalerror(201003032);
  4292. highloc:=hsym.initialloc
  4293. end
  4294. else
  4295. highloc.loc:=LOC_INVALID;
  4296. eldef:=tarraydef(tparavarsym(p).vardef).elementdef;
  4297. g_array_rtti_helper(list,eldef,href,highloc,'fpc_initialize_array');
  4298. end
  4299. else
  4300. g_initialize(list,tparavarsym(p).vardef,href);
  4301. end;
  4302. end;
  4303. end;
  4304. end;
  4305. end;
  4306. end;
  4307. procedure thlcgobj.gen_load_para_value(list: TAsmList);
  4308. var
  4309. i: longint;
  4310. currpara: tparavarsym;
  4311. begin
  4312. if (po_assembler in current_procinfo.procdef.procoptions) or
  4313. { exceptfilters have a single hidden 'parentfp' parameter, which
  4314. is handled by tcg.g_proc_entry. }
  4315. (current_procinfo.procdef.proctypeoption=potype_exceptfilter) then
  4316. exit;
  4317. { Copy parameters to local references/registers }
  4318. for i:=0 to current_procinfo.procdef.paras.count-1 do
  4319. begin
  4320. currpara:=tparavarsym(current_procinfo.procdef.paras[i]);
  4321. gen_load_cgpara_loc(list,currpara.vardef,currpara.paraloc[calleeside],currpara.initialloc,paramanager.param_use_paraloc(currpara.paraloc[calleeside]));
  4322. end;
  4323. { generate copies of call by value parameters, must be done before
  4324. the initialization and body is parsed because the refcounts are
  4325. incremented using the local copies }
  4326. current_procinfo.procdef.parast.SymList.ForEachCall(@g_copyvalueparas,list);
  4327. if not(po_assembler in current_procinfo.procdef.procoptions) then
  4328. begin
  4329. { initialize refcounted paras, and trash others. Needed here
  4330. instead of in gen_initialize_code, because when a reference is
  4331. intialised or trashed while the pointer to that reference is kept
  4332. in a regvar, we add a register move and that one again has to
  4333. come after the parameter loading code as far as the register
  4334. allocator is concerned }
  4335. current_procinfo.procdef.parast.SymList.ForEachCall(@init_paras,list);
  4336. end;
  4337. end;
  4338. procedure thlcgobj.g_copyvalueparas(p: TObject; arg: pointer);
  4339. var
  4340. href : treference;
  4341. hreg : tregister;
  4342. list : TAsmList;
  4343. hsym : tparavarsym;
  4344. l : longint;
  4345. highloc,
  4346. localcopyloc : tlocation;
  4347. begin
  4348. list:=TAsmList(arg);
  4349. if (tsym(p).typ=paravarsym) and
  4350. (tparavarsym(p).varspez=vs_value) and
  4351. (paramanager.push_addr_param(tparavarsym(p).varspez,tparavarsym(p).vardef,current_procinfo.procdef.proccalloption)) then
  4352. begin
  4353. { we have no idea about the alignment at the caller side }
  4354. location_get_data_ref(list,tparavarsym(p).vardef,tparavarsym(p).initialloc,href,true,1);
  4355. if is_open_array(tparavarsym(p).vardef) or
  4356. is_array_of_const(tparavarsym(p).vardef) then
  4357. begin
  4358. { cdecl functions don't have a high pointer so it is not possible to generate
  4359. a local copy }
  4360. if not(current_procinfo.procdef.proccalloption in cdecl_pocalls) then
  4361. begin
  4362. if paramanager.push_high_param(tparavarsym(p).varspez,tparavarsym(p).vardef,current_procinfo.procdef.proccalloption) then
  4363. begin
  4364. hsym:=tparavarsym(get_high_value_sym(tparavarsym(p)));
  4365. if not assigned(hsym) then
  4366. internalerror(2011020506);
  4367. highloc:=hsym.initialloc
  4368. end
  4369. else
  4370. highloc.loc:=LOC_INVALID;
  4371. hreg:=getaddressregister(list,voidpointertype);
  4372. if not is_packed_array(tparavarsym(p).vardef) then
  4373. g_copyvaluepara_openarray(list,href,highloc,tarraydef(tparavarsym(p).vardef),hreg)
  4374. else
  4375. internalerror(2011020507);
  4376. // cg.g_copyvaluepara_packedopenarray(list,href,hsym.intialloc,tarraydef(tparavarsym(p).vardef).elepackedbitsize,hreg);
  4377. a_load_reg_loc(list,tparavarsym(p).vardef,tparavarsym(p).vardef,hreg,tparavarsym(p).initialloc);
  4378. end;
  4379. end
  4380. else
  4381. begin
  4382. { Allocate space for the local copy }
  4383. l:=tparavarsym(p).getsize;
  4384. localcopyloc.loc:=LOC_REFERENCE;
  4385. localcopyloc.size:=int_cgsize(l);
  4386. tg.GetLocal(list,l,tparavarsym(p).vardef,localcopyloc.reference);
  4387. { Copy data }
  4388. if is_shortstring(tparavarsym(p).vardef) then
  4389. begin
  4390. { this code is only executed before the code for the body and the entry/exit code is generated
  4391. so we're allowed to include pi_do_call here; after pass1 is run, this isn't allowed anymore
  4392. }
  4393. include(current_procinfo.flags,pi_do_call);
  4394. g_copyshortstring(list,href,localcopyloc.reference,tstringdef(tparavarsym(p).vardef))
  4395. end
  4396. else if tparavarsym(p).vardef.typ=variantdef then
  4397. begin
  4398. { this code is only executed before the code for the body and the entry/exit code is generated
  4399. so we're allowed to include pi_do_call here; after pass1 is run, this isn't allowed anymore
  4400. }
  4401. include(current_procinfo.flags,pi_do_call);
  4402. g_copyvariant(list,href,localcopyloc.reference,tvariantdef(tparavarsym(p).vardef))
  4403. end
  4404. else
  4405. begin
  4406. { pass proper alignment info }
  4407. localcopyloc.reference.alignment:=tparavarsym(p).vardef.alignment;
  4408. g_concatcopy(list,tparavarsym(p).vardef,href,localcopyloc.reference);
  4409. end;
  4410. { update localloc of varsym }
  4411. tg.Ungetlocal(list,tparavarsym(p).localloc.reference);
  4412. tparavarsym(p).localloc:=localcopyloc;
  4413. tparavarsym(p).initialloc:=localcopyloc;
  4414. end;
  4415. end;
  4416. end;
  4417. procedure thlcgobj.gen_loadfpu_loc_cgpara(list: TAsmList; size: tdef; const l: tlocation; const cgpara: tcgpara; locintsize: longint);
  4418. var
  4419. tmploc: tlocation;
  4420. begin
  4421. case l.loc of
  4422. LOC_MMREGISTER,
  4423. LOC_CMMREGISTER:
  4424. case cgpara.location^.loc of
  4425. LOC_REFERENCE,
  4426. LOC_CREFERENCE,
  4427. LOC_MMREGISTER,
  4428. LOC_CMMREGISTER,
  4429. LOC_REGISTER,
  4430. LOC_CREGISTER :
  4431. a_loadmm_reg_cgpara(list,size,l.register,cgpara,mms_movescalar);
  4432. LOC_FPUREGISTER,
  4433. LOC_CFPUREGISTER:
  4434. begin
  4435. tmploc:=l;
  4436. location_force_fpureg(list,tmploc,size,false);
  4437. a_loadfpu_reg_cgpara(list,size,tmploc.register,cgpara);
  4438. end;
  4439. else
  4440. internalerror(200204249);
  4441. end;
  4442. LOC_FPUREGISTER,
  4443. LOC_CFPUREGISTER:
  4444. case cgpara.location^.loc of
  4445. LOC_MMREGISTER,
  4446. LOC_CMMREGISTER:
  4447. begin
  4448. tmploc:=l;
  4449. location_force_mmregscalar(list,tmploc,size,false);
  4450. a_loadmm_reg_cgpara(list,size,tmploc.register,cgpara,mms_movescalar);
  4451. end;
  4452. { Some targets pass floats in normal registers }
  4453. LOC_REGISTER,
  4454. LOC_CREGISTER,
  4455. LOC_REFERENCE,
  4456. LOC_CREFERENCE,
  4457. LOC_FPUREGISTER,
  4458. LOC_CFPUREGISTER:
  4459. a_loadfpu_reg_cgpara(list,size,l.register,cgpara);
  4460. else
  4461. internalerror(2011010210);
  4462. end;
  4463. LOC_REFERENCE,
  4464. LOC_CREFERENCE:
  4465. case cgpara.location^.loc of
  4466. LOC_MMREGISTER,
  4467. LOC_CMMREGISTER:
  4468. a_loadmm_ref_cgpara(list,size,l.reference,cgpara,mms_movescalar);
  4469. { Some targets pass floats in normal registers }
  4470. LOC_REGISTER,
  4471. LOC_CREGISTER,
  4472. LOC_REFERENCE,
  4473. LOC_CREFERENCE,
  4474. LOC_FPUREGISTER,
  4475. LOC_CFPUREGISTER:
  4476. a_loadfpu_ref_cgpara(list,size,l.reference,cgpara);
  4477. else
  4478. internalerror(2011010211);
  4479. end;
  4480. LOC_REGISTER,
  4481. LOC_CREGISTER :
  4482. a_load_loc_cgpara(list,size,l,cgpara);
  4483. else
  4484. internalerror(2011010212);
  4485. end;
  4486. end;
  4487. procedure thlcgobj.gen_load_uninitialized_function_result(list: TAsmList; pd: tprocdef; resdef: tdef; const resloc: tcgpara);
  4488. begin
  4489. { do nothing by default }
  4490. end;
  4491. procedure thlcgobj.gen_load_loc_cgpara(list: TAsmList; vardef: tdef; const l: tlocation; const cgpara: tcgpara);
  4492. begin
  4493. { Handle Floating point types differently
  4494. This doesn't depend on emulator settings, emulator settings should
  4495. be handled by cpupara }
  4496. if (vardef.typ=floatdef) or
  4497. { some ABIs return certain records in an fpu register }
  4498. (l.loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER]) or
  4499. (assigned(cgpara.location) and
  4500. (cgpara.Location^.loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER])) then
  4501. begin
  4502. gen_loadfpu_loc_cgpara(list,vardef,l,cgpara,vardef.size);
  4503. exit;
  4504. end;
  4505. case l.loc of
  4506. LOC_CONSTANT,
  4507. LOC_REGISTER,
  4508. LOC_CREGISTER,
  4509. LOC_REFERENCE,
  4510. LOC_CREFERENCE :
  4511. begin
  4512. a_load_loc_cgpara(list,vardef,l,cgpara);
  4513. end;
  4514. LOC_MMREGISTER,
  4515. LOC_CMMREGISTER:
  4516. begin
  4517. if use_vectorfpu(vardef) then
  4518. a_loadmm_loc_cgpara(list,vardef,l,cgpara,mms_movescalar)
  4519. else
  4520. { no vector support yet }
  4521. internalerror(2012071212);
  4522. {
  4523. cg.a_loadmm_loc_cgpara(list,l,cgpara,nil);
  4524. }
  4525. end;
  4526. else
  4527. internalerror(2011010213);
  4528. end;
  4529. end;
  4530. procedure thlcgobj.gen_load_cgpara_loc(list: TAsmList; vardef: tdef; const para: TCGPara; var destloc: tlocation; reusepara: boolean);
  4531. var
  4532. href : treference;
  4533. begin
  4534. para.check_simple_location;
  4535. { skip e.g. empty records }
  4536. if (para.location^.loc = LOC_VOID) then
  4537. exit;
  4538. case destloc.loc of
  4539. LOC_REFERENCE :
  4540. begin
  4541. { If the parameter location is reused we don't need to copy
  4542. anything }
  4543. if not reusepara then
  4544. begin
  4545. case para.location^.loc of
  4546. LOC_REFERENCE,LOC_CREFERENCE:
  4547. begin
  4548. reference_reset_base(href,voidstackpointertype,para.location^.reference.index,para.location^.reference.offset,para.alignment);
  4549. a_load_ref_ref(list,para.def,para.def,href,destloc.reference);
  4550. end;
  4551. else
  4552. internalerror(2013102301);
  4553. end;
  4554. end;
  4555. end;
  4556. { TODO other possible locations }
  4557. else
  4558. internalerror(2011010308);
  4559. end;
  4560. end;
  4561. procedure thlcgobj.gen_load_return_value(list: TAsmList);
  4562. var
  4563. ressym : tabstractnormalvarsym;
  4564. funcretloc : TCGPara;
  4565. retdef : tdef;
  4566. begin
  4567. { Is the loading needed? }
  4568. if is_void(current_procinfo.procdef.returndef) or
  4569. (
  4570. (po_assembler in current_procinfo.procdef.procoptions) and
  4571. (not(assigned(current_procinfo.procdef.funcretsym)) or
  4572. (tabstractvarsym(current_procinfo.procdef.funcretsym).refs=0) or
  4573. (po_nostackframe in current_procinfo.procdef.procoptions))
  4574. ) then
  4575. exit;
  4576. funcretloc:=current_procinfo.procdef.funcretloc[calleeside];
  4577. { constructors return self }
  4578. if (current_procinfo.procdef.proctypeoption=potype_constructor) then
  4579. begin
  4580. ressym:=tabstractnormalvarsym(current_procinfo.procdef.parast.Find('self'));
  4581. retdef:=ressym.vardef;
  4582. { and TP-style constructors return a pointer to self }
  4583. if is_object(ressym.vardef) then
  4584. retdef:=getpointerdef(retdef);
  4585. end
  4586. else
  4587. begin
  4588. ressym:=tabstractnormalvarsym(current_procinfo.procdef.funcretsym);
  4589. retdef:=ressym.vardef;
  4590. end;
  4591. if (ressym.refs>0) or
  4592. is_managed_type(retdef) then
  4593. begin
  4594. { was: don't do anything if funcretloc.loc in [LOC_INVALID,LOC_REFERENCE] }
  4595. if not paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef) then
  4596. gen_load_loc_cgpara(list,retdef,ressym.localloc,funcretloc);
  4597. end
  4598. else
  4599. gen_load_uninitialized_function_result(list,current_procinfo.procdef,retdef,funcretloc)
  4600. end;
  4601. procedure thlcgobj.record_generated_code_for_procdef(pd: tprocdef; code, data: TAsmList);
  4602. begin
  4603. { add the procedure to the al_procedures }
  4604. maybe_new_object_file(current_asmdata.asmlists[al_procedures]);
  4605. new_section(current_asmdata.asmlists[al_procedures],sec_code,lower(pd.mangledname),getprocalign);
  4606. current_asmdata.asmlists[al_procedures].concatlist(code);
  4607. { save local data (casetable) also in the same file }
  4608. if assigned(data) and
  4609. (not data.empty) then
  4610. current_asmdata.asmlists[al_procedures].concatlist(data);
  4611. end;
  4612. function thlcgobj.g_call_system_proc(list: TAsmList; const procname: string; forceresdef: tdef): tcgpara;
  4613. var
  4614. pd: tprocdef;
  4615. begin
  4616. pd:=search_system_proc(procname);
  4617. result:=g_call_system_proc_intern(list,pd,forceresdef);
  4618. end;
  4619. function thlcgobj.g_call_system_proc(list: TAsmList; pd: tprocdef; forceresdef: tdef): tcgpara;
  4620. begin
  4621. { separate non-virtual routine to make it clear that the routine to
  4622. override, if any, is g_call_system_proc_intern (and that none of
  4623. the g_call_system_proc variants should be made virtual) }
  4624. result:=g_call_system_proc_intern(list,pd,forceresdef);
  4625. end;
  4626. function thlcgobj.g_call_system_proc_intern(list: TAsmList; pd: tprocdef; forceresdef: tdef): tcgpara;
  4627. begin
  4628. allocallcpuregisters(list);
  4629. result:=a_call_name(list,pd,pd.mangledname,forceresdef,false);
  4630. deallocallcpuregisters(list);
  4631. end;
  4632. end.