hlcgobj.pas 213 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390439143924393439443954396439743984399440044014402440344044405440644074408440944104411441244134414441544164417441844194420442144224423442444254426442744284429443044314432443344344435443644374438443944404441444244434444444544464447444844494450445144524453445444554456445744584459446044614462446344644465446644674468446944704471447244734474447544764477447844794480448144824483448444854486448744884489449044914492449344944495449644974498449945004501450245034504450545064507450845094510451145124513451445154516451745184519452045214522452345244525452645274528452945304531453245334534453545364537453845394540454145424543454445454546454745484549455045514552455345544555455645574558455945604561456245634564456545664567456845694570457145724573457445754576457745784579458045814582458345844585458645874588458945904591459245934594459545964597459845994600460146024603460446054606460746084609461046114612461346144615461646174618461946204621462246234624462546264627462846294630463146324633463446354636463746384639464046414642464346444645464646474648464946504651465246534654465546564657465846594660466146624663466446654666466746684669467046714672467346744675467646774678467946804681468246834684468546864687468846894690469146924693469446954696469746984699470047014702470347044705470647074708470947104711471247134714471547164717471847194720472147224723472447254726472747284729473047314732473347344735473647374738473947404741474247434744474547464747474847494750475147524753475447554756475747584759476047614762476347644765476647674768476947704771477247734774477547764777477847794780478147824783478447854786478747884789479047914792479347944795479647974798479948004801480248034804480548064807480848094810481148124813481448154816481748184819482048214822482348244825482648274828482948304831483248334834483548364837483848394840484148424843484448454846484748484849485048514852485348544855485648574858485948604861486248634864486548664867486848694870487148724873487448754876487748784879488048814882488348844885488648874888488948904891489248934894489548964897489848994900490149024903490449054906490749084909491049114912491349144915491649174918491949204921492249234924492549264927492849294930493149324933493449354936493749384939494049414942494349444945494649474948494949504951495249534954495549564957495849594960496149624963496449654966496749684969497049714972497349744975497649774978497949804981498249834984498549864987498849894990499149924993499449954996499749984999500050015002500350045005500650075008500950105011501250135014
  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. offsetsym : tfieldvarsym;
  2770. begin
  2771. cgpara1.init;
  2772. cgpara2.init;
  2773. offsetsym:=nil;
  2774. if is_interfacecom_or_dispinterface(t) then
  2775. incrfunc:='fpc_intf_incr_ref'
  2776. else if is_ansistring(t) then
  2777. incrfunc:='fpc_ansistr_incr_ref'
  2778. else if is_widestring(t) then
  2779. incrfunc:='fpc_widestr_incr_ref'
  2780. else if is_unicodestring(t) then
  2781. incrfunc:='fpc_unicodestr_incr_ref'
  2782. else if is_dynamic_array(t) then
  2783. incrfunc:='fpc_dynarray_incr_ref'
  2784. else if is_class(t) and (oo_is_reference_counted in tobjectdef(t).objectoptions) then
  2785. begin
  2786. incrfunc:='fpc_refcountclass_incr_ref';
  2787. offsetsym:=tfieldvarsym(tobjectdef(t).refcount_field);
  2788. if not assigned(offsetsym) or (offsetsym.typ<>fieldvarsym) then
  2789. internalerror(2014092201);
  2790. end
  2791. else
  2792. incrfunc:='';
  2793. { call the special incr function or the generic addref }
  2794. if incrfunc<>'' then
  2795. begin
  2796. pd:=search_system_proc(incrfunc);
  2797. paramanager.getintparaloc(pd,1,cgpara1);
  2798. { widestrings aren't ref. counted on all platforms so we need the address
  2799. to create a real copy }
  2800. if is_widestring(t) then
  2801. a_loadaddr_ref_cgpara(list,t,ref,cgpara1)
  2802. else
  2803. { these functions get the pointer by value }
  2804. a_load_ref_cgpara(list,t,ref,cgpara1);
  2805. paramanager.freecgpara(list,cgpara1);
  2806. if assigned(offsetsym) then
  2807. begin
  2808. paramanager.getintparaloc(pd,2,cgpara2);
  2809. a_load_const_cgpara(list,s32inttype,offsetsym.fieldoffset,cgpara2);
  2810. paramanager.freecgpara(list,cgpara2);
  2811. end;
  2812. g_call_system_proc(list,pd,nil);
  2813. end
  2814. else
  2815. begin
  2816. pd:=search_system_proc('fpc_addref');
  2817. paramanager.getintparaloc(pd,1,cgpara1);
  2818. paramanager.getintparaloc(pd,2,cgpara2);
  2819. if is_open_array(t) then
  2820. InternalError(201103054);
  2821. reference_reset_symbol(href,RTTIWriter.get_rtti_label(t,initrtti),0,sizeof(pint));
  2822. if pd.is_pushleftright then
  2823. begin
  2824. a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
  2825. a_loadaddr_ref_cgpara(list,voidpointertype,href,cgpara2);
  2826. end
  2827. else
  2828. begin
  2829. a_loadaddr_ref_cgpara(list,voidpointertype,href,cgpara2);
  2830. a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
  2831. end;
  2832. paramanager.freecgpara(list,cgpara1);
  2833. paramanager.freecgpara(list,cgpara2);
  2834. g_call_system_proc(list,pd,nil);
  2835. end;
  2836. cgpara2.done;
  2837. cgpara1.done;
  2838. end;
  2839. procedure thlcgobj.g_initialize(list: TAsmList; t: tdef; const ref: treference);
  2840. var
  2841. href : treference;
  2842. cgpara1,cgpara2 : TCGPara;
  2843. pd : tprocdef;
  2844. begin
  2845. cgpara1.init;
  2846. cgpara2.init;
  2847. if is_ansistring(t) or
  2848. is_widestring(t) or
  2849. is_unicodestring(t) or
  2850. is_interfacecom_or_dispinterface(t) or
  2851. is_dynamic_array(t) or
  2852. (is_class(t) and (oo_is_reference_counted in tobjectdef(t).objectoptions)) then
  2853. a_load_const_ref(list,t,0,ref)
  2854. else if t.typ=variantdef then
  2855. begin
  2856. pd:=search_system_proc('fpc_variant_init');
  2857. paramanager.getintparaloc(pd,1,cgpara1);
  2858. a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
  2859. paramanager.freecgpara(list,cgpara1);
  2860. g_call_system_proc(list,pd,nil);
  2861. end
  2862. else
  2863. begin
  2864. if is_open_array(t) then
  2865. InternalError(201103052);
  2866. pd:=search_system_proc('fpc_initialize');
  2867. paramanager.getintparaloc(pd,1,cgpara1);
  2868. paramanager.getintparaloc(pd,2,cgpara2);
  2869. reference_reset_symbol(href,RTTIWriter.get_rtti_label(t,initrtti),0,sizeof(pint));
  2870. if pd.is_pushleftright then
  2871. begin
  2872. a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
  2873. a_loadaddr_ref_cgpara(list,voidpointertype,href,cgpara2);
  2874. end
  2875. else
  2876. begin
  2877. a_loadaddr_ref_cgpara(list,voidpointertype,href,cgpara2);
  2878. a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
  2879. end;
  2880. paramanager.freecgpara(list,cgpara1);
  2881. paramanager.freecgpara(list,cgpara2);
  2882. g_call_system_proc(list,pd,nil);
  2883. end;
  2884. cgpara1.done;
  2885. cgpara2.done;
  2886. end;
  2887. procedure thlcgobj.g_finalize(list: TAsmList; t: tdef; const ref: treference);
  2888. var
  2889. href : treference;
  2890. cgpara1,cgpara2 : TCGPara;
  2891. pd : tprocdef;
  2892. decrfunc : string;
  2893. offsetsym : tfieldvarsym;
  2894. begin
  2895. offsetsym:=nil;
  2896. if is_interfacecom_or_dispinterface(t) then
  2897. decrfunc:='fpc_intf_decr_ref'
  2898. else if is_ansistring(t) then
  2899. decrfunc:='fpc_ansistr_decr_ref'
  2900. else if is_widestring(t) then
  2901. decrfunc:='fpc_widestr_decr_ref'
  2902. else if is_unicodestring(t) then
  2903. decrfunc:='fpc_unicodestr_decr_ref'
  2904. else if t.typ=variantdef then
  2905. decrfunc:='fpc_variant_clear'
  2906. else if is_class(t) and (oo_is_reference_counted in tobjectdef(t).objectoptions) then
  2907. begin
  2908. decrfunc:='fpc_refcountclass_decr_ref';
  2909. offsetsym:=tfieldvarsym(tobjectdef(t).refcount_field);
  2910. if not assigned(offsetsym) or (offsetsym.typ<>fieldvarsym) then
  2911. internalerror(2014092203);
  2912. end
  2913. else
  2914. begin
  2915. cgpara1.init;
  2916. cgpara2.init;
  2917. if is_open_array(t) then
  2918. InternalError(201103051);
  2919. { fpc_finalize takes a pointer value parameter, fpc_dynarray_clear a
  2920. pointer var parameter }
  2921. if is_dynamic_array(t) then
  2922. pd:=search_system_proc('fpc_dynarray_clear')
  2923. else
  2924. pd:=search_system_proc('fpc_finalize');
  2925. paramanager.getintparaloc(pd,1,cgpara1);
  2926. paramanager.getintparaloc(pd,2,cgpara2);
  2927. reference_reset_symbol(href,RTTIWriter.get_rtti_label(t,initrtti),0,sizeof(pint));
  2928. if pd.is_pushleftright then
  2929. begin
  2930. a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
  2931. a_loadaddr_ref_cgpara(list,voidpointertype,href,cgpara2);
  2932. end
  2933. else
  2934. begin
  2935. a_loadaddr_ref_cgpara(list,voidpointertype,href,cgpara2);
  2936. a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
  2937. end;
  2938. paramanager.freecgpara(list,cgpara1);
  2939. paramanager.freecgpara(list,cgpara2);
  2940. g_call_system_proc(list,pd,nil);
  2941. cgpara1.done;
  2942. cgpara2.done;
  2943. exit;
  2944. end;
  2945. pd:=search_system_proc(decrfunc);
  2946. cgpara1.init;
  2947. cgpara2.init;
  2948. paramanager.getintparaloc(pd,1,cgpara1);
  2949. a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
  2950. paramanager.freecgpara(list,cgpara1);
  2951. if assigned(offsetsym) then
  2952. begin
  2953. paramanager.getintparaloc(pd,2,cgpara2);
  2954. a_load_const_cgpara(list,s32inttype,offsetsym.fieldoffset,cgpara2);
  2955. paramanager.freecgpara(list,cgpara2);
  2956. end;
  2957. g_call_system_proc(list,pd,nil);
  2958. cgpara1.done;
  2959. cgpara2.done;
  2960. end;
  2961. procedure thlcgobj.g_array_rtti_helper(list: TAsmList; t: tdef; const ref: treference; const highloc: tlocation; const name: string);
  2962. var
  2963. cgpara1,cgpara2,cgpara3: TCGPara;
  2964. href: TReference;
  2965. hreg, lenreg: TRegister;
  2966. pd: tprocdef;
  2967. begin
  2968. cgpara1.init;
  2969. cgpara2.init;
  2970. cgpara3.init;
  2971. pd:=search_system_proc(name);
  2972. paramanager.getintparaloc(pd,1,cgpara1);
  2973. paramanager.getintparaloc(pd,2,cgpara2);
  2974. paramanager.getintparaloc(pd,3,cgpara3);
  2975. reference_reset_symbol(href,RTTIWriter.get_rtti_label(t,initrtti),0,sizeof(pint));
  2976. { if calling convention is left to right, push parameters 1 and 2 }
  2977. if pd.is_pushleftright then
  2978. begin
  2979. a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
  2980. a_loadaddr_ref_cgpara(list,voidpointertype,href,cgpara2);
  2981. end;
  2982. { push parameter 3 }
  2983. if highloc.loc=LOC_CONSTANT then
  2984. a_load_const_cgpara(list,ptrsinttype,highloc.value+1,cgpara3)
  2985. else
  2986. begin
  2987. if highloc.loc in [LOC_REGISTER,LOC_CREGISTER] then
  2988. hreg:=highloc.register
  2989. else
  2990. begin
  2991. hreg:=getintregister(list,ptrsinttype);
  2992. a_load_loc_reg(list,ptrsinttype,ptrsinttype,highloc,hreg);
  2993. end;
  2994. { increment, converts high(x) to length(x) }
  2995. lenreg:=getintregister(list,ptrsinttype);
  2996. a_op_const_reg_reg(list,OP_ADD,ptrsinttype,1,hreg,lenreg);
  2997. a_load_reg_cgpara(list,ptrsinttype,lenreg,cgpara3);
  2998. end;
  2999. { if calling convention is right to left, push parameters 2 and 1 }
  3000. if not pd.is_pushleftright then
  3001. begin
  3002. a_loadaddr_ref_cgpara(list,voidpointertype,href,cgpara2);
  3003. a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
  3004. end;
  3005. paramanager.freecgpara(list,cgpara1);
  3006. paramanager.freecgpara(list,cgpara2);
  3007. paramanager.freecgpara(list,cgpara3);
  3008. g_call_system_proc(list,pd,nil);
  3009. cgpara3.done;
  3010. cgpara2.done;
  3011. cgpara1.done;
  3012. end;
  3013. procedure thlcgobj.g_rangecheck(list: TAsmList; const l: tlocation; fromdef, todef: tdef);
  3014. var
  3015. {$if defined(cpu64bitalu) or defined(cpu32bitalu)}
  3016. aintmax: aint;
  3017. {$else}
  3018. aintmax: longint;
  3019. {$endif}
  3020. neglabel : tasmlabel;
  3021. hreg : tregister;
  3022. lto,hto,
  3023. lfrom,hfrom : TConstExprInt;
  3024. fromsize, tosize: cardinal;
  3025. maxdef: tdef;
  3026. from_signed, to_signed: boolean;
  3027. begin
  3028. { range checking on and range checkable value? }
  3029. if not(cs_check_range in current_settings.localswitches) or
  3030. not(fromdef.typ in [orddef,enumdef]) or
  3031. { C-style booleans can't really fail range checks, }
  3032. { all values are always valid }
  3033. is_cbool(todef) then
  3034. exit;
  3035. {$if not defined(cpuhighleveltarget) and not defined(cpu64bitalu)}
  3036. { handle 64bit rangechecks separate for 32bit processors }
  3037. if is_64bit(fromdef) or is_64bit(todef) then
  3038. begin
  3039. cg64.g_rangecheck64(list,l,fromdef,todef);
  3040. exit;
  3041. end;
  3042. {$endif ndef cpuhighleveltarget and ndef cpu64bitalu}
  3043. { only check when assigning to scalar, subranges are different, }
  3044. { when todef=fromdef then the check is always generated }
  3045. getrange(fromdef,lfrom,hfrom);
  3046. getrange(todef,lto,hto);
  3047. from_signed := is_signed(fromdef);
  3048. to_signed := is_signed(todef);
  3049. { check the rangedef of the array, not the array itself }
  3050. { (only change now, since getrange needs the arraydef) }
  3051. if (todef.typ = arraydef) then
  3052. todef := tarraydef(todef).rangedef;
  3053. { no range check if from and to are equal and are both longint/dword }
  3054. { (if we have a 32bit processor) or int64/qword, since such }
  3055. { operations can at most cause overflows (JM) }
  3056. { Note that these checks are mostly processor independent, they only }
  3057. { have to be changed once we introduce 64bit subrange types }
  3058. {$if defined(cpuhighleveltarget) or defined(cpu64bitalu)}
  3059. if (fromdef=todef) and
  3060. (fromdef.typ=orddef) and
  3061. (((((torddef(fromdef).ordtype=s64bit) and
  3062. (lfrom = low(int64)) and
  3063. (hfrom = high(int64))) or
  3064. ((torddef(fromdef).ordtype=u64bit) and
  3065. (lfrom = low(qword)) and
  3066. (hfrom = high(qword))) or
  3067. ((torddef(fromdef).ordtype=scurrency) and
  3068. (lfrom = low(int64)) and
  3069. (hfrom = high(int64)))))) then
  3070. exit;
  3071. {$endif cpuhighleveltarget or cpu64bitalu}
  3072. { 32 bit operations are automatically widened to 64 bit on 64 bit addr
  3073. targets }
  3074. {$ifdef cpu32bitaddr}
  3075. if (fromdef = todef) and
  3076. (fromdef.typ=orddef) and
  3077. (((((torddef(fromdef).ordtype = s32bit) and
  3078. (lfrom = int64(low(longint))) and
  3079. (hfrom = int64(high(longint)))) or
  3080. ((torddef(fromdef).ordtype = u32bit) and
  3081. (lfrom = low(cardinal)) and
  3082. (hfrom = high(cardinal)))))) then
  3083. exit;
  3084. {$endif cpu32bitaddr}
  3085. { optimize some range checks away in safe cases }
  3086. fromsize := fromdef.size;
  3087. tosize := todef.size;
  3088. if ((from_signed = to_signed) or
  3089. (not from_signed)) and
  3090. (lto<=lfrom) and (hto>=hfrom) and
  3091. (fromsize <= tosize) then
  3092. begin
  3093. { if fromsize < tosize, and both have the same signed-ness or }
  3094. { fromdef is unsigned, then all bit patterns from fromdef are }
  3095. { valid for todef as well }
  3096. if (fromsize < tosize) then
  3097. exit;
  3098. if (fromsize = tosize) and
  3099. (from_signed = to_signed) then
  3100. { only optimize away if all bit patterns which fit in fromsize }
  3101. { are valid for the todef }
  3102. begin
  3103. {$ifopt Q+}
  3104. {$define overflowon}
  3105. {$Q-}
  3106. {$endif}
  3107. {$ifopt R+}
  3108. {$define rangeon}
  3109. {$R-}
  3110. {$endif}
  3111. if to_signed then
  3112. begin
  3113. { calculation of the low/high ranges must not overflow 64 bit
  3114. otherwise we end up comparing with zero for 64 bit data types on
  3115. 64 bit processors }
  3116. if (lto = (int64(-1) << (tosize * 8 - 1))) and
  3117. (hto = (-((int64(-1) << (tosize * 8 - 1))+1))) then
  3118. exit
  3119. end
  3120. else
  3121. begin
  3122. { calculation of the low/high ranges must not overflow 64 bit
  3123. otherwise we end up having all zeros for 64 bit data types on
  3124. 64 bit processors }
  3125. if (lto = 0) and
  3126. (qword(hto) = (qword(-1) >> (64-(tosize * 8))) ) then
  3127. exit
  3128. end;
  3129. {$ifdef overflowon}
  3130. {$Q+}
  3131. {$undef overflowon}
  3132. {$endif}
  3133. {$ifdef rangeon}
  3134. {$R+}
  3135. {$undef rangeon}
  3136. {$endif}
  3137. end
  3138. end;
  3139. { depending on the types involved, we perform the range check for 64 or
  3140. for 32 bit }
  3141. if fromsize=8 then
  3142. maxdef:=fromdef
  3143. else
  3144. maxdef:=todef;
  3145. {$if sizeof(aintmax) = 8}
  3146. if maxdef.size=8 then
  3147. aintmax:=high(int64)
  3148. else
  3149. {$endif}
  3150. begin
  3151. aintmax:=high(longint);
  3152. maxdef:=u32inttype;
  3153. end;
  3154. { generate the rangecheck code for the def where we are going to }
  3155. { store the result }
  3156. { use the trick that }
  3157. { a <= x <= b <=> 0 <= x-a <= b-a <=> unsigned(x-a) <= unsigned(b-a) }
  3158. { To be able to do that, we have to make sure however that either }
  3159. { fromdef and todef are both signed or unsigned, or that we leave }
  3160. { the parts < 0 and > maxlongint out }
  3161. if from_signed xor to_signed then
  3162. begin
  3163. if from_signed then
  3164. { from is signed, to is unsigned }
  3165. begin
  3166. { if high(from) < 0 -> always range error }
  3167. if (hfrom < 0) or
  3168. { if low(to) > maxlongint also range error }
  3169. (lto > aintmax) then
  3170. begin
  3171. g_call_system_proc(list,'fpc_rangeerror',nil);
  3172. exit
  3173. end;
  3174. { from is signed and to is unsigned -> when looking at to }
  3175. { as an signed value, it must be < maxaint (otherwise }
  3176. { it will become negative, which is invalid since "to" is unsigned) }
  3177. if hto > aintmax then
  3178. hto := aintmax;
  3179. end
  3180. else
  3181. { from is unsigned, to is signed }
  3182. begin
  3183. if (lfrom > aintmax) or
  3184. (hto < 0) then
  3185. begin
  3186. g_call_system_proc(list,'fpc_rangeerror',nil);
  3187. exit
  3188. end;
  3189. { from is unsigned and to is signed -> when looking at to }
  3190. { as an unsigned value, it must be >= 0 (since negative }
  3191. { values are the same as values > maxlongint) }
  3192. if lto < 0 then
  3193. lto := 0;
  3194. end;
  3195. end;
  3196. hreg:=getintregister(list,maxdef);
  3197. a_load_loc_reg(list,fromdef,maxdef,l,hreg);
  3198. a_op_const_reg(list,OP_SUB,maxdef,tcgint(int64(lto)),hreg);
  3199. current_asmdata.getjumplabel(neglabel);
  3200. {
  3201. if from_signed then
  3202. a_cmp_const_reg_label(list,OS_INT,OC_GTE,aint(hto-lto),hreg,neglabel)
  3203. else
  3204. }
  3205. if qword(hto-lto)>qword(aintmax) then
  3206. a_cmp_const_reg_label(list,maxdef,OC_BE,aintmax,hreg,neglabel)
  3207. else
  3208. a_cmp_const_reg_label(list,maxdef,OC_BE,tcgint(int64(hto-lto)),hreg,neglabel);
  3209. g_call_system_proc(list,'fpc_rangeerror',nil);
  3210. a_label(list,neglabel);
  3211. end;
  3212. procedure thlcgobj.g_copyvaluepara_openarray(list: TAsmList; const ref: treference; const lenloc: tlocation; arrdef: tarraydef; destreg: tregister);
  3213. var
  3214. sizereg,sourcereg,lenreg : tregister;
  3215. cgpara1,cgpara2,cgpara3 : TCGPara;
  3216. ptrarrdef : tdef;
  3217. pd : tprocdef;
  3218. getmemres : tcgpara;
  3219. destloc : tlocation;
  3220. begin
  3221. { because some abis don't support dynamic stack allocation properly
  3222. open array value parameters are copied onto the heap
  3223. }
  3224. { calculate necessary memory }
  3225. { read/write operations on one register make the life of the register allocator hard }
  3226. if not(lenloc.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  3227. begin
  3228. lenreg:=getintregister(list,sinttype);
  3229. a_load_loc_reg(list,sinttype,sinttype,lenloc,lenreg);
  3230. end
  3231. else
  3232. lenreg:=lenloc.register;
  3233. sizereg:=getintregister(list,sinttype);
  3234. a_op_const_reg_reg(list,OP_ADD,sinttype,1,lenreg,sizereg);
  3235. a_op_const_reg(list,OP_IMUL,sinttype,arrdef.elesize,sizereg);
  3236. { load source }
  3237. ptrarrdef:=getpointerdef(arrdef);
  3238. sourcereg:=getaddressregister(list,ptrarrdef);
  3239. a_loadaddr_ref_reg(list,arrdef,ptrarrdef,ref,sourcereg);
  3240. { do getmem call }
  3241. pd:=search_system_proc('fpc_getmem');
  3242. cgpara1.init;
  3243. paramanager.getintparaloc(pd,1,cgpara1);
  3244. a_load_reg_cgpara(list,sinttype,sizereg,cgpara1);
  3245. paramanager.freecgpara(list,cgpara1);
  3246. getmemres:=g_call_system_proc(list,pd,ptrarrdef);
  3247. cgpara1.done;
  3248. { return the new address }
  3249. location_reset(destloc,LOC_REGISTER,OS_ADDR);
  3250. destloc.register:=destreg;
  3251. gen_load_cgpara_loc(list,ptrarrdef,getmemres,destloc,false);
  3252. { do move call }
  3253. pd:=search_system_proc('MOVE');
  3254. cgpara1.init;
  3255. cgpara2.init;
  3256. cgpara3.init;
  3257. paramanager.getintparaloc(pd,1,cgpara1);
  3258. paramanager.getintparaloc(pd,2,cgpara2);
  3259. paramanager.getintparaloc(pd,3,cgpara3);
  3260. if pd.is_pushleftright then
  3261. begin
  3262. { load source }
  3263. a_load_reg_cgpara(list,ptrarrdef,sourcereg,cgpara1);
  3264. { load destination }
  3265. a_load_reg_cgpara(list,ptrarrdef,destreg,cgpara2);
  3266. { load size }
  3267. a_load_reg_cgpara(list,ptrsinttype,sizereg,cgpara3);
  3268. end
  3269. else
  3270. begin
  3271. { load size }
  3272. a_load_reg_cgpara(list,ptrsinttype,sizereg,cgpara3);
  3273. { load destination }
  3274. a_load_reg_cgpara(list,ptrarrdef,destreg,cgpara2);
  3275. { load source }
  3276. a_load_reg_cgpara(list,ptrarrdef,sourcereg,cgpara1);
  3277. end;
  3278. paramanager.freecgpara(list,cgpara3);
  3279. paramanager.freecgpara(list,cgpara2);
  3280. paramanager.freecgpara(list,cgpara1);
  3281. g_call_system_proc(list,pd,nil);
  3282. cgpara3.done;
  3283. cgpara2.done;
  3284. cgpara1.done;
  3285. getmemres.resetiftemp;
  3286. end;
  3287. procedure thlcgobj.g_releasevaluepara_openarray(list: TAsmList; arrdef: tarraydef; const l: tlocation);
  3288. var
  3289. cgpara1 : TCGPara;
  3290. pd : tprocdef;
  3291. begin
  3292. { do freemem call }
  3293. pd:=search_system_proc('fpc_freemem');
  3294. cgpara1.init;
  3295. paramanager.getintparaloc(pd,1,cgpara1);
  3296. { load source }
  3297. a_load_loc_cgpara(list,getpointerdef(arrdef),l,cgpara1);
  3298. paramanager.freecgpara(list,cgpara1);
  3299. g_call_system_proc(list,pd,nil);
  3300. cgpara1.done;
  3301. end;
  3302. procedure thlcgobj.g_profilecode(list: TAsmList);
  3303. begin
  3304. end;
  3305. procedure thlcgobj.g_allocload_reg_reg(list: TAsmList; regsize: tdef; const fromreg: tregister; out toreg: tregister; regtyp: tregistertype);
  3306. begin
  3307. case regtyp of
  3308. R_INTREGISTER:
  3309. toreg:=getintregister(list,regsize);
  3310. R_ADDRESSREGISTER:
  3311. toreg:=getaddressregister(list,regsize);
  3312. R_FPUREGISTER:
  3313. toreg:=getfpuregister(list,regsize);
  3314. else
  3315. internalerror(2013112910);
  3316. end;
  3317. a_load_reg_reg(list,regsize,regsize,fromreg,toreg);
  3318. end;
  3319. procedure thlcgobj.g_reference_loc(list: TAsmList; def: tdef; const fromloc: tlocation; out toloc: tlocation);
  3320. procedure handle_reg_move(regsize: tdef; const fromreg: tregister; out toreg: tregister; regtyp: tregistertype);
  3321. begin
  3322. case regtyp of
  3323. R_INTREGISTER:
  3324. toreg:=getintregister(list,regsize);
  3325. R_ADDRESSREGISTER:
  3326. toreg:=getaddressregister(list,regsize);
  3327. R_FPUREGISTER:
  3328. toreg:=getfpuregister(list,regsize);
  3329. else
  3330. internalerror(2013112915);
  3331. end;
  3332. a_load_reg_reg(list,regsize,regsize,fromreg,toreg);
  3333. end;
  3334. begin
  3335. toloc:=fromloc;
  3336. case fromloc.loc of
  3337. { volatile location, can't get a permanent reference }
  3338. LOC_REGISTER,
  3339. LOC_FPUREGISTER:
  3340. internalerror(2012012702);
  3341. LOC_CONSTANT:
  3342. { finished }
  3343. ;
  3344. LOC_CREGISTER:
  3345. handle_reg_move(def,fromloc.reference.index,toloc.reference.index,R_INTREGISTER);
  3346. LOC_CFPUREGISTER:
  3347. handle_reg_move(def,fromloc.reference.index,toloc.reference.index,R_FPUREGISTER);
  3348. { although LOC_CREFERENCE cannot be an lvalue, we may want to take a
  3349. reference to such a location for multiple reading }
  3350. LOC_CREFERENCE,
  3351. LOC_REFERENCE:
  3352. begin
  3353. if (fromloc.reference.base<>NR_NO) and
  3354. (fromloc.reference.base<>current_procinfo.framepointer) and
  3355. (fromloc.reference.base<>NR_STACK_POINTER_REG) then
  3356. handle_reg_move(voidpointertype,fromloc.reference.base,toloc.reference.base,getregtype(fromloc.reference.base));
  3357. if (fromloc.reference.index<>NR_NO) and
  3358. (fromloc.reference.index<>current_procinfo.framepointer) and
  3359. (fromloc.reference.index<>NR_STACK_POINTER_REG) then
  3360. handle_reg_move(voidpointertype,fromloc.reference.index,toloc.reference.index,getregtype(fromloc.reference.index));
  3361. end;
  3362. else
  3363. internalerror(2012012701);
  3364. end;
  3365. end;
  3366. procedure thlcgobj.location_force_reg(list: TAsmList; var l: tlocation; src_size, dst_size: tdef; maybeconst: boolean);
  3367. var
  3368. hregister,
  3369. hregister2: tregister;
  3370. hl : tasmlabel;
  3371. oldloc : tlocation;
  3372. begin
  3373. oldloc:=l;
  3374. hregister:=getregisterfordef(list,dst_size);
  3375. { load value in new register }
  3376. case l.loc of
  3377. {$ifdef cpuflags}
  3378. LOC_FLAGS :
  3379. begin
  3380. g_flags2reg(list,dst_size,l.resflags,hregister);
  3381. cg.a_reg_dealloc(list,NR_DEFAULTFLAGS);
  3382. end;
  3383. {$endif cpuflags}
  3384. LOC_JUMP :
  3385. begin
  3386. a_label(list,current_procinfo.CurrTrueLabel);
  3387. a_load_const_reg(list,dst_size,1,hregister);
  3388. current_asmdata.getjumplabel(hl);
  3389. a_jmp_always(list,hl);
  3390. a_label(list,current_procinfo.CurrFalseLabel);
  3391. a_load_const_reg(list,dst_size,0,hregister);
  3392. a_label(list,hl);
  3393. end;
  3394. else
  3395. begin
  3396. { load_loc_reg can only handle size >= l.size, when the
  3397. new size is smaller then we need to adjust the size
  3398. of the orignal and maybe recalculate l.register for i386 }
  3399. if (dst_size.size<src_size.size) then
  3400. begin
  3401. hregister2:=getregisterfordef(list,src_size);
  3402. { prevent problems with memory locations -- at this high
  3403. level we cannot twiddle with the reference offset, since
  3404. that may not mean anything (e.g., it refers to fixed-sized
  3405. stack slots on Java) }
  3406. a_load_loc_reg(list,src_size,src_size,l,hregister2);
  3407. a_load_reg_reg(list,src_size,dst_size,hregister2,hregister);
  3408. end
  3409. else
  3410. a_load_loc_reg(list,src_size,dst_size,l,hregister);
  3411. end;
  3412. end;
  3413. if (l.loc <> LOC_CREGISTER) or
  3414. not maybeconst then
  3415. location_reset(l,LOC_REGISTER,def_cgsize(dst_size))
  3416. else
  3417. location_reset(l,LOC_CREGISTER,def_cgsize(dst_size));
  3418. l.register:=hregister;
  3419. { Release temp if it was a reference }
  3420. if oldloc.loc=LOC_REFERENCE then
  3421. location_freetemp(list,oldloc);
  3422. end;
  3423. procedure thlcgobj.location_force_fpureg(list: TAsmList; var l: tlocation; size: tdef; maybeconst: boolean);
  3424. var
  3425. reg : tregister;
  3426. begin
  3427. if (l.loc<>LOC_FPUREGISTER) and
  3428. ((l.loc<>LOC_CFPUREGISTER) or (not maybeconst)) then
  3429. begin
  3430. { if it's in an mm register, store to memory first }
  3431. if (l.loc in [LOC_MMREGISTER,LOC_CMMREGISTER]) then
  3432. location_force_mem(list,l,size);
  3433. reg:=getfpuregister(list,size);
  3434. a_loadfpu_loc_reg(list,size,size,l,reg);
  3435. location_freetemp(list,l);
  3436. location_reset(l,LOC_FPUREGISTER,l.size);
  3437. l.register:=reg;
  3438. end;
  3439. end;
  3440. procedure thlcgobj.location_force_mem(list: TAsmList; var l: tlocation; size: tdef);
  3441. var
  3442. r : treference;
  3443. forcesize: aint;
  3444. begin
  3445. case l.loc of
  3446. LOC_FPUREGISTER,
  3447. LOC_CFPUREGISTER :
  3448. begin
  3449. tg.gethltemp(list,size,size.size,tt_normal,r);
  3450. a_loadfpu_reg_ref(list,size,size,l.register,r);
  3451. location_reset_ref(l,LOC_REFERENCE,l.size,0);
  3452. l.reference:=r;
  3453. end;
  3454. LOC_MMREGISTER,
  3455. LOC_CMMREGISTER:
  3456. begin
  3457. { vectors can't be represented yet using tdef }
  3458. if size.typ<>floatdef then
  3459. internalerror(2012062301);
  3460. tg.gethltemp(list,size,size.size,tt_normal,r);
  3461. a_loadmm_reg_ref(list,size,size,l.register,r,mms_movescalar);
  3462. location_reset_ref(l,LOC_REFERENCE,l.size,0);
  3463. l.reference:=r;
  3464. end;
  3465. LOC_CONSTANT,
  3466. LOC_REGISTER,
  3467. LOC_CREGISTER,
  3468. LOC_SUBSETREG,
  3469. LOC_CSUBSETREG,
  3470. LOC_SUBSETREF,
  3471. LOC_CSUBSETREF:
  3472. begin
  3473. if not is_dynamic_array(size) and
  3474. not is_open_array(size) then
  3475. forcesize:=size.size
  3476. else
  3477. forcesize:=sizeof(pint);
  3478. tg.gethltemp(list,size,forcesize,tt_normal,r);
  3479. a_load_loc_ref(list,size,size,l,r);
  3480. location_reset_ref(l,LOC_REFERENCE,l.size,0);
  3481. l.reference:=r;
  3482. end;
  3483. LOC_CREFERENCE,
  3484. LOC_REFERENCE : ;
  3485. else
  3486. internalerror(2011010304);
  3487. end;
  3488. end;
  3489. procedure thlcgobj.location_force_mmregscalar(list: TAsmList; var l: tlocation; size: tdef; maybeconst: boolean);
  3490. var
  3491. reg : tregister;
  3492. href : treference;
  3493. newsize : tdef;
  3494. begin
  3495. if (l.loc<>LOC_MMREGISTER) and
  3496. ((l.loc<>LOC_CMMREGISTER) or (not maybeconst)) then
  3497. begin
  3498. { if it's in an fpu register, store to memory first }
  3499. if (l.loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER]) then
  3500. begin
  3501. tg.gethltemp(list,size,-1,tt_normal,href);
  3502. hlcg.a_loadfpu_reg_ref(list,size,size,l.register,href);
  3503. location_reset_ref(l,LOC_REFERENCE,l.size,0);
  3504. l.reference:=href;
  3505. end;
  3506. { on ARM, CFP values may be located in integer registers,
  3507. and its second_int_to_real() also uses this routine to
  3508. force integer (memory) values in an mmregister }
  3509. if (l.size in [OS_32,OS_S32]) then
  3510. begin
  3511. size:=cgsize_orddef(l.size);
  3512. newsize:=s32floattype;
  3513. end
  3514. else if (l.size in [OS_64,OS_S64]) then
  3515. begin
  3516. size:=cgsize_orddef(l.size);
  3517. newsize:=s64floattype;
  3518. end
  3519. else
  3520. newsize:=size;
  3521. case size.size of
  3522. 4:
  3523. newsize:=s32floattype;
  3524. 8:
  3525. newsize:=s64floattype;
  3526. else
  3527. newsize:=size;
  3528. end;
  3529. reg:=hlcg.getmmregister(list,newsize);
  3530. hlcg.a_loadmm_loc_reg(list,size,newsize,l,reg,mms_movescalar);
  3531. l.size:=def_cgsize(newsize);
  3532. location_freetemp(list,l);
  3533. location_reset(l,LOC_MMREGISTER,l.size);
  3534. l.register:=reg;
  3535. end;
  3536. end;
  3537. procedure thlcgobj.location_get_data_ref(list: TAsmList; def: tdef; const l: tlocation; var ref: treference; loadref: boolean; alignment: longint);
  3538. begin
  3539. case l.loc of
  3540. LOC_REGISTER,
  3541. LOC_CREGISTER :
  3542. begin
  3543. if not loadref then
  3544. internalerror(200410231);
  3545. reference_reset_base(ref,voidpointertype,l.register,0,alignment);
  3546. end;
  3547. LOC_REFERENCE,
  3548. LOC_CREFERENCE :
  3549. begin
  3550. if loadref then
  3551. begin
  3552. reference_reset_base(ref,voidpointertype,getaddressregister(list,voidpointertype),0,alignment);
  3553. { it's a pointer to def }
  3554. a_load_ref_reg(list,voidpointertype,voidpointertype,l.reference,ref.base);
  3555. end
  3556. else
  3557. ref:=l.reference;
  3558. end;
  3559. else
  3560. internalerror(200309181);
  3561. end;
  3562. end;
  3563. procedure thlcgobj.maketojumpbool(list: TAsmList; p: tnode);
  3564. {
  3565. produces jumps to true respectively false labels using boolean expressions
  3566. depending on whether the loading of regvars is currently being
  3567. synchronized manually (such as in an if-node) or automatically (most of
  3568. the other cases where this procedure is called), loadregvars can be
  3569. "lr_load_regvars" or "lr_dont_load_regvars"
  3570. }
  3571. var
  3572. storepos : tfileposinfo;
  3573. begin
  3574. if nf_error in p.flags then
  3575. exit;
  3576. storepos:=current_filepos;
  3577. current_filepos:=p.fileinfo;
  3578. if is_boolean(p.resultdef) then
  3579. begin
  3580. if is_constboolnode(p) then
  3581. begin
  3582. if Tordconstnode(p).value.uvalue<>0 then
  3583. a_jmp_always(list,current_procinfo.CurrTrueLabel)
  3584. else
  3585. a_jmp_always(list,current_procinfo.CurrFalseLabel)
  3586. end
  3587. else
  3588. begin
  3589. case p.location.loc of
  3590. LOC_SUBSETREG,LOC_CSUBSETREG,
  3591. LOC_SUBSETREF,LOC_CSUBSETREF,
  3592. LOC_CREGISTER,LOC_REGISTER,LOC_CREFERENCE,LOC_REFERENCE :
  3593. begin
  3594. a_cmp_const_loc_label(list,p.resultdef,OC_NE,0,p.location,current_procinfo.CurrTrueLabel);
  3595. a_jmp_always(list,current_procinfo.CurrFalseLabel);
  3596. end;
  3597. LOC_JUMP:
  3598. ;
  3599. {$ifdef cpuflags}
  3600. LOC_FLAGS :
  3601. begin
  3602. a_jmp_flags(list,p.location.resflags,current_procinfo.CurrTrueLabel);
  3603. a_reg_dealloc(list,NR_DEFAULTFLAGS);
  3604. a_jmp_always(list,current_procinfo.CurrFalseLabel);
  3605. end;
  3606. {$endif cpuflags}
  3607. else
  3608. begin
  3609. printnode(output,p);
  3610. internalerror(2011010418);
  3611. end;
  3612. end;
  3613. end;
  3614. end
  3615. else
  3616. internalerror(2011010419);
  3617. current_filepos:=storepos;
  3618. end;
  3619. procedure thlcgobj.maybe_change_load_node_reg(list: TAsmList; var n: tnode; reload: boolean);
  3620. var
  3621. rr: treplaceregrec;
  3622. varloc : tai_varloc;
  3623. begin
  3624. if not (n.location.loc in [LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMXREGISTER,LOC_CMMREGISTER]) or
  3625. ([fc_inflowcontrol,fc_gotolabel,fc_lefthandled] * flowcontrol <> []) then
  3626. exit;
  3627. rr.old := n.location.register;
  3628. rr.ressym := nil;
  3629. rr.sym := nil;
  3630. rr.oldhi := NR_NO;
  3631. case n.location.loc of
  3632. LOC_CREGISTER:
  3633. begin
  3634. {$ifdef cpu64bitalu}
  3635. if (n.location.size in [OS_128,OS_S128]) then
  3636. begin
  3637. rr.oldhi := n.location.register128.reghi;
  3638. rr.new := cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
  3639. rr.newhi := cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
  3640. end
  3641. else
  3642. {$else cpu64bitalu}
  3643. if (n.location.size in [OS_64,OS_S64]) then
  3644. begin
  3645. rr.oldhi := n.location.register64.reghi;
  3646. rr.new := cg.getintregister(current_asmdata.CurrAsmList,OS_32);
  3647. rr.newhi := cg.getintregister(current_asmdata.CurrAsmList,OS_32);
  3648. end
  3649. else
  3650. {$endif cpu64bitalu}
  3651. rr.new := cg.getintregister(current_asmdata.CurrAsmList,n.location.size);
  3652. end;
  3653. LOC_CFPUREGISTER:
  3654. rr.new := cg.getfpuregister(current_asmdata.CurrAsmList,n.location.size);
  3655. {$ifdef SUPPORT_MMX}
  3656. LOC_CMMXREGISTER:
  3657. rr.new := tcgx86(cg).getmmxregister(current_asmdata.CurrAsmList);
  3658. {$endif SUPPORT_MMX}
  3659. LOC_CMMREGISTER:
  3660. rr.new := cg.getmmregister(current_asmdata.CurrAsmList,n.location.size);
  3661. else
  3662. exit;
  3663. end;
  3664. { self is implicitly returned from constructors, even if there are no
  3665. references to it; additionally, funcretsym is not set for constructor
  3666. procdefs }
  3667. if (current_procinfo.procdef.proctypeoption=potype_constructor) then
  3668. rr.ressym:=tsym(current_procinfo.procdef.parast.Find('self'))
  3669. else if not is_void(current_procinfo.procdef.returndef) and
  3670. assigned(current_procinfo.procdef.funcretsym) and
  3671. (tabstractvarsym(current_procinfo.procdef.funcretsym).refs <> 0) then
  3672. rr.ressym:=current_procinfo.procdef.funcretsym;
  3673. if not foreachnode(n,@do_replace_node_regs,@rr) then
  3674. exit;
  3675. if reload then
  3676. case n.location.loc of
  3677. LOC_CREGISTER:
  3678. begin
  3679. {$ifdef cpu64bitalu}
  3680. if (n.location.size in [OS_128,OS_S128]) then
  3681. cg128.a_load128_reg_reg(list,n.location.register128,joinreg128(rr.new,rr.newhi))
  3682. else
  3683. {$else cpu64bitalu}
  3684. if (n.location.size in [OS_64,OS_S64]) then
  3685. cg64.a_load64_reg_reg(list,n.location.register64,joinreg64(rr.new,rr.newhi))
  3686. else
  3687. {$endif cpu64bitalu}
  3688. cg.a_load_reg_reg(list,n.location.size,n.location.size,n.location.register,rr.new);
  3689. end;
  3690. LOC_CFPUREGISTER:
  3691. cg.a_loadfpu_reg_reg(list,n.location.size,n.location.size,n.location.register,rr.new);
  3692. {$ifdef SUPPORT_MMX}
  3693. LOC_CMMXREGISTER:
  3694. cg.a_loadmm_reg_reg(list,OS_M64,OS_M64,n.location.register,rr.new,nil);
  3695. {$endif SUPPORT_MMX}
  3696. LOC_CMMREGISTER:
  3697. cg.a_loadmm_reg_reg(list,n.location.size,n.location.size,n.location.register,rr.new,nil);
  3698. else
  3699. internalerror(2006090920);
  3700. end;
  3701. { now that we've change the loadn/temp, also change the node result location }
  3702. {$ifdef cpu64bitalu}
  3703. if (n.location.size in [OS_128,OS_S128]) then
  3704. begin
  3705. n.location.register128.reglo := rr.new;
  3706. n.location.register128.reghi := rr.newhi;
  3707. if assigned(rr.sym) and
  3708. ((rr.sym.currentregloc.register<>rr.new) or
  3709. (rr.sym.currentregloc.registerhi<>rr.newhi)) then
  3710. begin
  3711. varloc:=tai_varloc.create128(rr.sym,rr.new,rr.newhi);
  3712. varloc.oldlocation:=rr.sym.currentregloc.register;
  3713. varloc.oldlocationhi:=rr.sym.currentregloc.registerhi;
  3714. rr.sym.currentregloc.register:=rr.new;
  3715. rr.sym.currentregloc.registerHI:=rr.newhi;
  3716. list.concat(varloc);
  3717. end;
  3718. end
  3719. else
  3720. {$else cpu64bitalu}
  3721. if (n.location.size in [OS_64,OS_S64]) then
  3722. begin
  3723. n.location.register64.reglo := rr.new;
  3724. n.location.register64.reghi := rr.newhi;
  3725. if assigned(rr.sym) and
  3726. ((rr.sym.currentregloc.register<>rr.new) or
  3727. (rr.sym.currentregloc.registerhi<>rr.newhi)) then
  3728. begin
  3729. varloc:=tai_varloc.create64(rr.sym,rr.new,rr.newhi);
  3730. varloc.oldlocation:=rr.sym.currentregloc.register;
  3731. varloc.oldlocationhi:=rr.sym.currentregloc.registerhi;
  3732. rr.sym.currentregloc.register:=rr.new;
  3733. rr.sym.currentregloc.registerHI:=rr.newhi;
  3734. list.concat(varloc);
  3735. end;
  3736. end
  3737. else
  3738. {$endif cpu64bitalu}
  3739. begin
  3740. n.location.register := rr.new;
  3741. if assigned(rr.sym) and (rr.sym.currentregloc.register<>rr.new) then
  3742. begin
  3743. varloc:=tai_varloc.create(rr.sym,rr.new);
  3744. varloc.oldlocation:=rr.sym.currentregloc.register;
  3745. rr.sym.currentregloc.register:=rr.new;
  3746. list.concat(varloc);
  3747. end;
  3748. end;
  3749. end;
  3750. function thlcgobj.do_replace_node_regs(var n: tnode; para: pointer): foreachnoderesult;
  3751. var
  3752. rr: preplaceregrec absolute para;
  3753. begin
  3754. result := fen_false;
  3755. if (nf_is_funcret in n.flags) and (fc_exit in flowcontrol) then
  3756. exit;
  3757. case n.nodetype of
  3758. loadn:
  3759. begin
  3760. if (tloadnode(n).symtableentry.typ in [localvarsym,paravarsym,staticvarsym]) and
  3761. (tabstractvarsym(tloadnode(n).symtableentry).varoptions * [vo_is_dll_var, vo_is_thread_var] = []) and
  3762. not assigned(tloadnode(n).left) and
  3763. ((tloadnode(n).symtableentry <> rr^.ressym) or
  3764. not(fc_exit in flowcontrol)
  3765. ) and
  3766. (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.loc in [LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMXREGISTER,LOC_CMMREGISTER]) and
  3767. (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.register = rr^.old) then
  3768. begin
  3769. {$ifdef cpu64bitalu}
  3770. { it's possible a 128 bit location was shifted and/xor typecasted }
  3771. { in a 64 bit value, so only 1 register was left in the location }
  3772. if (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.size in [OS_128,OS_S128]) then
  3773. if (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.register128.reghi = rr^.oldhi) then
  3774. tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.register128.reghi := rr^.newhi
  3775. else
  3776. exit;
  3777. {$else cpu64bitalu}
  3778. { it's possible a 64 bit location was shifted and/xor typecasted }
  3779. { in a 32 bit value, so only 1 register was left in the location }
  3780. if (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.size in [OS_64,OS_S64]) then
  3781. if (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.register64.reghi = rr^.oldhi) then
  3782. tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.register64.reghi := rr^.newhi
  3783. else
  3784. exit;
  3785. {$endif cpu64bitalu}
  3786. tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.register := rr^.new;
  3787. rr^.sym := tabstractnormalvarsym(tloadnode(n).symtableentry);
  3788. result := fen_norecurse_true;
  3789. end;
  3790. end;
  3791. temprefn:
  3792. begin
  3793. if (ti_valid in ttemprefnode(n).tempinfo^.flags) and
  3794. (ttemprefnode(n).tempinfo^.location.loc in [LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMXREGISTER,LOC_CMMREGISTER]) and
  3795. (ttemprefnode(n).tempinfo^.location.register = rr^.old) then
  3796. begin
  3797. {$ifdef cpu64bitalu}
  3798. { it's possible a 128 bit location was shifted and/xor typecasted }
  3799. { in a 64 bit value, so only 1 register was left in the location }
  3800. if (ttemprefnode(n).tempinfo^.location.size in [OS_128,OS_S128]) then
  3801. if (ttemprefnode(n).tempinfo^.location.register128.reghi = rr^.oldhi) then
  3802. ttemprefnode(n).tempinfo^.location.register128.reghi := rr^.newhi
  3803. else
  3804. exit;
  3805. {$else cpu64bitalu}
  3806. { it's possible a 64 bit location was shifted and/xor typecasted }
  3807. { in a 32 bit value, so only 1 register was left in the location }
  3808. if (ttemprefnode(n).tempinfo^.location.size in [OS_64,OS_S64]) then
  3809. if (ttemprefnode(n).tempinfo^.location.register64.reghi = rr^.oldhi) then
  3810. ttemprefnode(n).tempinfo^.location.register64.reghi := rr^.newhi
  3811. else
  3812. exit;
  3813. {$endif cpu64bitalu}
  3814. ttemprefnode(n).tempinfo^.location.register := rr^.new;
  3815. result := fen_norecurse_true;
  3816. end;
  3817. end;
  3818. { optimize the searching a bit }
  3819. derefn,addrn,
  3820. calln,inlinen,casen,
  3821. addn,subn,muln,
  3822. andn,orn,xorn,
  3823. ltn,lten,gtn,gten,equaln,unequaln,
  3824. slashn,divn,shrn,shln,notn,
  3825. inn,
  3826. asn,isn:
  3827. result := fen_norecurse_false;
  3828. end;
  3829. end;
  3830. procedure thlcgobj.gen_proc_symbol(list: TAsmList);
  3831. var
  3832. item,
  3833. previtem : TCmdStrListItem;
  3834. begin
  3835. previtem:=nil;
  3836. item := TCmdStrListItem(current_procinfo.procdef.aliasnames.first);
  3837. while assigned(item) do
  3838. begin
  3839. {$ifdef arm}
  3840. if GenerateThumbCode or GenerateThumb2Code then
  3841. list.concat(tai_thumb_func.create);
  3842. {$endif arm}
  3843. { "double link" all procedure entry symbols via .reference }
  3844. { directives on darwin, because otherwise the linker }
  3845. { sometimes strips the procedure if only on of the symbols }
  3846. { is referenced }
  3847. if assigned(previtem) and
  3848. (target_info.system in systems_darwin) then
  3849. list.concat(tai_directive.create(asd_reference,item.str));
  3850. if (cs_profile in current_settings.moduleswitches) or
  3851. (po_global in current_procinfo.procdef.procoptions) then
  3852. list.concat(Tai_symbol.createname_global(item.str,AT_FUNCTION,0))
  3853. else
  3854. list.concat(Tai_symbol.createname(item.str,AT_FUNCTION,0));
  3855. if assigned(previtem) and
  3856. (target_info.system in systems_darwin) then
  3857. list.concat(tai_directive.create(asd_reference,previtem.str));
  3858. if not(af_stabs_use_function_absolute_addresses in target_asm.flags) then
  3859. list.concat(Tai_function_name.create(item.str));
  3860. previtem:=item;
  3861. item := TCmdStrListItem(item.next);
  3862. end;
  3863. current_procinfo.procdef.procstarttai:=tai(list.last);
  3864. end;
  3865. procedure thlcgobj.gen_proc_symbol_end(list: TAsmList);
  3866. begin
  3867. list.concat(Tai_symbol_end.Createname(current_procinfo.procdef.mangledname));
  3868. current_procinfo.procdef.procendtai:=tai(list.last);
  3869. if (current_module.islibrary) then
  3870. if (current_procinfo.procdef.proctypeoption = potype_proginit) then
  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],current_procinfo.procdef.mangledname);
  3874. if (current_procinfo.procdef.proctypeoption=potype_proginit) then
  3875. begin
  3876. if (target_info.system in (systems_darwin+[system_powerpc_macos]+systems_aix)) and
  3877. not(current_module.islibrary) then
  3878. begin
  3879. new_section(list,sec_code,'',4);
  3880. list.concat(tai_symbol.createname_global(
  3881. target_info.cprefix+mainaliasname,AT_FUNCTION,0));
  3882. { keep argc, argv and envp properly on the stack }
  3883. if not(target_info.system in systems_aix) then
  3884. cg.a_jmp_name(list,target_info.cprefix+'FPC_SYSTEMMAIN')
  3885. else
  3886. cg.a_call_name(list,target_info.cprefix+'FPC_SYSTEMMAIN',false)
  3887. end;
  3888. end;
  3889. end;
  3890. procedure thlcgobj.gen_initialize_code(list: TAsmList);
  3891. begin
  3892. { initialize local data like ansistrings }
  3893. case current_procinfo.procdef.proctypeoption of
  3894. potype_unitinit:
  3895. begin
  3896. { this is also used for initialization of variables in a
  3897. program which does not have a globalsymtable }
  3898. if assigned(current_module.globalsymtable) then
  3899. TSymtable(current_module.globalsymtable).SymList.ForEachCall(@initialize_data,list);
  3900. TSymtable(current_module.localsymtable).SymList.ForEachCall(@initialize_data,list);
  3901. TSymtable(current_module.localsymtable).SymList.ForEachCall(@initialize_regvars,list);
  3902. end;
  3903. { units have seperate code for initilization and finalization }
  3904. potype_unitfinalize: ;
  3905. { program init/final is generated in separate procedure }
  3906. potype_proginit:
  3907. begin
  3908. TSymtable(current_module.localsymtable).SymList.ForEachCall(@initialize_regvars,list);
  3909. end;
  3910. else
  3911. current_procinfo.procdef.localst.SymList.ForEachCall(@initialize_data,list);
  3912. end;
  3913. { initialises temp. ansi/wide string data }
  3914. if (current_procinfo.procdef.proctypeoption<>potype_exceptfilter) then
  3915. inittempvariables(list);
  3916. {$ifdef OLDREGVARS}
  3917. load_regvars(list,nil);
  3918. {$endif OLDREGVARS}
  3919. end;
  3920. procedure thlcgobj.gen_finalize_code(list: TAsmList);
  3921. var
  3922. old_current_procinfo: tprocinfo;
  3923. begin
  3924. old_current_procinfo:=current_procinfo;
  3925. if (current_procinfo.procdef.proctypeoption=potype_exceptfilter) then
  3926. begin
  3927. if (current_procinfo.parent.finalize_procinfo<>current_procinfo) then
  3928. exit;
  3929. current_procinfo:=current_procinfo.parent;
  3930. end;
  3931. {$ifdef OLDREGVARS}
  3932. cleanup_regvars(list);
  3933. {$endif OLDREGVARS}
  3934. { finalize temporary data }
  3935. finalizetempvariables(list);
  3936. { finalize local data like ansistrings}
  3937. case current_procinfo.procdef.proctypeoption of
  3938. potype_unitfinalize:
  3939. begin
  3940. { this is also used for initialization of variables in a
  3941. program which does not have a globalsymtable }
  3942. if assigned(current_module.globalsymtable) then
  3943. TSymtable(current_module.globalsymtable).SymList.ForEachCall(@finalize_static_data,list);
  3944. TSymtable(current_module.localsymtable).SymList.ForEachCall(@finalize_static_data,list);
  3945. end;
  3946. { units/progs have separate code for initialization and finalization }
  3947. potype_unitinit: ;
  3948. { program init/final is generated in separate procedure }
  3949. potype_proginit: ;
  3950. else
  3951. current_procinfo.procdef.localst.SymList.ForEachCall(@finalize_local_vars,list);
  3952. end;
  3953. { finalize paras data }
  3954. if assigned(current_procinfo.procdef.parast) and
  3955. not(po_assembler in current_procinfo.procdef.procoptions) then
  3956. current_procinfo.procdef.parast.SymList.ForEachCall(@final_paras,list);
  3957. current_procinfo:=old_current_procinfo;
  3958. end;
  3959. procedure thlcgobj.gen_entry_code(list: TAsmList);
  3960. begin
  3961. { the actual profile code can clobber some registers,
  3962. therefore if the context must be saved, do it before
  3963. the actual call to the profile code
  3964. }
  3965. if (cs_profile in current_settings.moduleswitches) and
  3966. not(po_assembler in current_procinfo.procdef.procoptions) then
  3967. begin
  3968. { non-win32 can call mcout even in main }
  3969. if not (target_info.system in [system_i386_win32,system_i386_wdosx]) or
  3970. not (current_procinfo.procdef.proctypeoption=potype_proginit) then
  3971. begin
  3972. g_profilecode(list);
  3973. end;
  3974. end;
  3975. { TODO: create high level version (create compilerprocs in system unit,
  3976. look up procdef, use hlcgobj.a_call_name()) }
  3977. { call startup helpers from main program }
  3978. if (current_procinfo.procdef.proctypeoption=potype_proginit) then
  3979. begin
  3980. { initialize units }
  3981. cg.allocallcpuregisters(list);
  3982. if not(current_module.islibrary) then
  3983. cg.a_call_name(list,'FPC_INITIALIZEUNITS',false)
  3984. else
  3985. cg.a_call_name(list,'FPC_LIBINITIALIZEUNITS',false);
  3986. cg.deallocallcpuregisters(list);
  3987. end;
  3988. list.concat(Tai_force_line.Create);
  3989. {$ifdef OLDREGVARS}
  3990. load_regvars(list,nil);
  3991. {$endif OLDREGVARS}
  3992. end;
  3993. procedure thlcgobj.gen_exit_code(list: TAsmList);
  3994. begin
  3995. { TODO: create high level version (create compilerproc in system unit,
  3996. look up procdef, use hlcgobj.a_call_name()) }
  3997. { call __EXIT for main program }
  3998. if (not DLLsource) and
  3999. (current_procinfo.procdef.proctypeoption=potype_proginit) then
  4000. cg.a_call_name(list,'FPC_DO_EXIT',false);
  4001. end;
  4002. procedure thlcgobj.inittempvariables(list: TAsmList);
  4003. var
  4004. hp : ptemprecord;
  4005. href : treference;
  4006. begin
  4007. hp:=tg.templist;
  4008. while assigned(hp) do
  4009. begin
  4010. if assigned(hp^.def) and
  4011. is_managed_type(hp^.def) then
  4012. begin
  4013. reference_reset_base(href,voidstackpointertype,current_procinfo.framepointer,hp^.pos,voidstackpointertype.size);
  4014. g_initialize(list,hp^.def,href);
  4015. end;
  4016. hp:=hp^.next;
  4017. end;
  4018. end;
  4019. procedure thlcgobj.initialize_data(p: TObject; arg: pointer);
  4020. var
  4021. OldAsmList : TAsmList;
  4022. hp : tnode;
  4023. begin
  4024. if (tsym(p).typ = localvarsym) and
  4025. { local (procedure or unit) variables only need initialization if
  4026. they are used }
  4027. ((tabstractvarsym(p).refs>0) or
  4028. { managed return symbols must be inited }
  4029. ((tsym(p).typ=localvarsym) and (vo_is_funcret in tlocalvarsym(p).varoptions))
  4030. ) and
  4031. not(vo_is_typed_const in tabstractvarsym(p).varoptions) and
  4032. not(vo_is_external in tabstractvarsym(p).varoptions) and
  4033. not(vo_is_default_var in tabstractvarsym(p).varoptions) and
  4034. (is_managed_type(tabstractvarsym(p).vardef) or
  4035. ((m_iso in current_settings.modeswitches) and (tabstractvarsym(p).vardef.typ=filedef))
  4036. ) then
  4037. begin
  4038. OldAsmList:=current_asmdata.CurrAsmList;
  4039. current_asmdata.CurrAsmList:=TAsmList(arg);
  4040. hp:=cnodeutils.initialize_data_node(cloadnode.create(tsym(p),tsym(p).owner),false);
  4041. firstpass(hp);
  4042. secondpass(hp);
  4043. hp.free;
  4044. current_asmdata.CurrAsmList:=OldAsmList;
  4045. end;
  4046. end;
  4047. procedure thlcgobj.finalizetempvariables(list: TAsmList);
  4048. var
  4049. hp : ptemprecord;
  4050. href : treference;
  4051. begin
  4052. hp:=tg.templist;
  4053. while assigned(hp) do
  4054. begin
  4055. if assigned(hp^.def) and
  4056. is_managed_type(hp^.def) then
  4057. begin
  4058. include(current_procinfo.flags,pi_needs_implicit_finally);
  4059. reference_reset_base(href,voidstackpointertype,current_procinfo.framepointer,hp^.pos,voidstackpointertype.size);
  4060. g_finalize(list,hp^.def,href);
  4061. end;
  4062. hp:=hp^.next;
  4063. end;
  4064. end;
  4065. procedure thlcgobj.initialize_regvars(p: TObject; arg: pointer);
  4066. var
  4067. href : treference;
  4068. begin
  4069. if (tsym(p).typ=staticvarsym) then
  4070. begin
  4071. { Static variables can have the initialloc only set to LOC_CxREGISTER
  4072. or LOC_INVALID, for explaination see gen_alloc_symtable (PFV) }
  4073. case tstaticvarsym(p).initialloc.loc of
  4074. LOC_CREGISTER :
  4075. begin
  4076. {$ifdef cpu64bitalu}
  4077. if (tstaticvarsym(p).initialloc.size in [OS_128,OS_S128]) then
  4078. cg128.a_load128_const_reg(TAsmList(arg),0,0,tstaticvarsym(p).initialloc.register128)
  4079. else
  4080. {$else cpu64bitalu}
  4081. if (tstaticvarsym(p).initialloc.size in [OS_64,OS_S64]) then
  4082. cg64.a_load64_const_reg(TAsmList(arg),0,tstaticvarsym(p).initialloc.register64)
  4083. else
  4084. {$endif cpu64bitalu}
  4085. a_load_const_reg(TAsmList(arg),tstaticvarsym(p).vardef,0,
  4086. tstaticvarsym(p).initialloc.register);
  4087. end;
  4088. LOC_CMMREGISTER :
  4089. { clear the whole register }
  4090. a_opmm_reg_reg(TAsmList(arg),OP_XOR,tstaticvarsym(p).vardef,
  4091. tstaticvarsym(p).initialloc.register,
  4092. tstaticvarsym(p).initialloc.register,
  4093. nil);
  4094. LOC_CFPUREGISTER :
  4095. begin
  4096. { initialize fpu regvar by loading from memory }
  4097. reference_reset_symbol(href,
  4098. current_asmdata.RefAsmSymbol(tstaticvarsym(p).mangledname), 0,
  4099. var_align(tstaticvarsym(p).vardef.alignment));
  4100. a_loadfpu_ref_reg(TAsmList(arg), tstaticvarsym(p).vardef,
  4101. tstaticvarsym(p).vardef, href, tstaticvarsym(p).initialloc.register);
  4102. end;
  4103. LOC_INVALID :
  4104. ;
  4105. else
  4106. internalerror(200410124);
  4107. end;
  4108. end;
  4109. end;
  4110. procedure thlcgobj.finalize_sym(asmlist: TAsmList; sym: tsym);
  4111. var
  4112. hp : tnode;
  4113. OldAsmList : TAsmList;
  4114. begin
  4115. include(current_procinfo.flags,pi_needs_implicit_finally);
  4116. OldAsmList:=current_asmdata.CurrAsmList;
  4117. current_asmdata.CurrAsmList:=asmlist;
  4118. hp:=cloadnode.create(sym,sym.owner);
  4119. if (sym.typ=staticvarsym) and (vo_force_finalize in tstaticvarsym(sym).varoptions) then
  4120. include(tloadnode(hp).loadnodeflags,loadnf_isinternal_ignoreconst);
  4121. hp:=cnodeutils.finalize_data_node(hp);
  4122. firstpass(hp);
  4123. secondpass(hp);
  4124. hp.free;
  4125. current_asmdata.CurrAsmList:=OldAsmList;
  4126. end;
  4127. procedure thlcgobj.finalize_local_vars(p: TObject; arg: pointer);
  4128. begin
  4129. if (tsym(p).typ=localvarsym) and
  4130. (tlocalvarsym(p).refs>0) and
  4131. not(vo_is_external in tlocalvarsym(p).varoptions) and
  4132. not(vo_is_funcret in tlocalvarsym(p).varoptions) and
  4133. not(vo_is_default_var in tabstractvarsym(p).varoptions) and
  4134. is_managed_type(tlocalvarsym(p).vardef) then
  4135. finalize_sym(TAsmList(arg),tsym(p));
  4136. end;
  4137. procedure thlcgobj.finalize_static_data(p: TObject; arg: pointer);
  4138. var
  4139. i : longint;
  4140. pd : tprocdef;
  4141. begin
  4142. case tsym(p).typ of
  4143. staticvarsym :
  4144. begin
  4145. { local (procedure or unit) variables only need finalization
  4146. if they are used
  4147. }
  4148. if ((tstaticvarsym(p).refs>0) or
  4149. { global (unit) variables always need finalization, since
  4150. they may also be used in another unit
  4151. }
  4152. (tstaticvarsym(p).owner.symtabletype=globalsymtable)) and
  4153. (
  4154. (tstaticvarsym(p).varspez<>vs_const) or
  4155. (vo_force_finalize in tstaticvarsym(p).varoptions)
  4156. ) and
  4157. not(vo_is_funcret in tstaticvarsym(p).varoptions) and
  4158. not(vo_is_external in tstaticvarsym(p).varoptions) and
  4159. is_managed_type(tstaticvarsym(p).vardef) and
  4160. not (
  4161. assigned(tstaticvarsym(p).fieldvarsym) and
  4162. assigned(tstaticvarsym(p).fieldvarsym.owner.defowner) and
  4163. (df_generic in tdef(tstaticvarsym(p).fieldvarsym.owner.defowner).defoptions)
  4164. )
  4165. then
  4166. finalize_sym(TAsmList(arg),tsym(p));
  4167. end;
  4168. procsym :
  4169. begin
  4170. for i:=0 to tprocsym(p).ProcdefList.Count-1 do
  4171. begin
  4172. pd:=tprocdef(tprocsym(p).ProcdefList[i]);
  4173. if assigned(pd.localst) and
  4174. (pd.procsym=tprocsym(p)) and
  4175. (pd.localst.symtabletype<>staticsymtable) then
  4176. pd.localst.SymList.ForEachCall(@finalize_static_data,arg);
  4177. end;
  4178. end;
  4179. end;
  4180. end;
  4181. procedure thlcgobj.final_paras(p: TObject; arg: pointer);
  4182. var
  4183. list : TAsmList;
  4184. href : treference;
  4185. hsym : tparavarsym;
  4186. eldef : tdef;
  4187. highloc : tlocation;
  4188. begin
  4189. if not(tsym(p).typ=paravarsym) then
  4190. exit;
  4191. list:=TAsmList(arg);
  4192. if is_managed_type(tparavarsym(p).vardef) and
  4193. not (vo_is_weakref in tparavarsym(p).varoptions) 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)) and
  4253. not (vo_is_weakref in tparavarsym(p).varoptions) then
  4254. begin
  4255. location_get_data_ref(list,tparavarsym(p).vardef,tparavarsym(p).initialloc,href,is_open_array(tparavarsym(p).vardef),sizeof(pint));
  4256. if is_open_array(tparavarsym(p).vardef) then
  4257. begin
  4258. if paramanager.push_high_param(tparavarsym(p).varspez,tparavarsym(p).vardef,current_procinfo.procdef.proccalloption) then
  4259. begin
  4260. hsym:=tparavarsym(get_high_value_sym(tparavarsym(p)));
  4261. if not assigned(hsym) then
  4262. internalerror(201003032);
  4263. highloc:=hsym.initialloc
  4264. end
  4265. else
  4266. highloc.loc:=LOC_INVALID;
  4267. { open arrays do not contain correct element count in their rtti,
  4268. the actual count must be passed separately. }
  4269. eldef:=tarraydef(tparavarsym(p).vardef).elementdef;
  4270. g_array_rtti_helper(list,eldef,href,highloc,'fpc_addref_array');
  4271. end
  4272. else
  4273. g_incrrefcount(list,tparavarsym(p).vardef,href);
  4274. end;
  4275. end;
  4276. vs_out :
  4277. begin
  4278. if needs_inittable then
  4279. begin
  4280. { we have no idea about the alignment at the callee side,
  4281. and the user also cannot specify "unaligned" here, so
  4282. assume worst case }
  4283. location_get_data_ref(list,tparavarsym(p).vardef,tparavarsym(p).initialloc,href,true,1);
  4284. if needs_inittable then
  4285. begin
  4286. if is_open_array(tparavarsym(p).vardef) then
  4287. begin
  4288. if paramanager.push_high_param(tparavarsym(p).varspez,tparavarsym(p).vardef,current_procinfo.procdef.proccalloption) then
  4289. begin
  4290. hsym:=tparavarsym(get_high_value_sym(tparavarsym(p)));
  4291. if not assigned(hsym) then
  4292. internalerror(201003032);
  4293. highloc:=hsym.initialloc
  4294. end
  4295. else
  4296. highloc.loc:=LOC_INVALID;
  4297. eldef:=tarraydef(tparavarsym(p).vardef).elementdef;
  4298. g_array_rtti_helper(list,eldef,href,highloc,'fpc_initialize_array');
  4299. end
  4300. else
  4301. g_initialize(list,tparavarsym(p).vardef,href);
  4302. end;
  4303. end;
  4304. end;
  4305. end;
  4306. end;
  4307. end;
  4308. procedure thlcgobj.gen_load_para_value(list: TAsmList);
  4309. var
  4310. i: longint;
  4311. currpara: tparavarsym;
  4312. begin
  4313. if (po_assembler in current_procinfo.procdef.procoptions) or
  4314. { exceptfilters have a single hidden 'parentfp' parameter, which
  4315. is handled by tcg.g_proc_entry. }
  4316. (current_procinfo.procdef.proctypeoption=potype_exceptfilter) then
  4317. exit;
  4318. { Copy parameters to local references/registers }
  4319. for i:=0 to current_procinfo.procdef.paras.count-1 do
  4320. begin
  4321. currpara:=tparavarsym(current_procinfo.procdef.paras[i]);
  4322. gen_load_cgpara_loc(list,currpara.vardef,currpara.paraloc[calleeside],currpara.initialloc,paramanager.param_use_paraloc(currpara.paraloc[calleeside]));
  4323. end;
  4324. { generate copies of call by value parameters, must be done before
  4325. the initialization and body is parsed because the refcounts are
  4326. incremented using the local copies }
  4327. current_procinfo.procdef.parast.SymList.ForEachCall(@g_copyvalueparas,list);
  4328. if not(po_assembler in current_procinfo.procdef.procoptions) then
  4329. begin
  4330. { initialize refcounted paras, and trash others. Needed here
  4331. instead of in gen_initialize_code, because when a reference is
  4332. intialised or trashed while the pointer to that reference is kept
  4333. in a regvar, we add a register move and that one again has to
  4334. come after the parameter loading code as far as the register
  4335. allocator is concerned }
  4336. current_procinfo.procdef.parast.SymList.ForEachCall(@init_paras,list);
  4337. end;
  4338. end;
  4339. procedure thlcgobj.g_copyvalueparas(p: TObject; arg: pointer);
  4340. var
  4341. href : treference;
  4342. hreg : tregister;
  4343. list : TAsmList;
  4344. hsym : tparavarsym;
  4345. l : longint;
  4346. highloc,
  4347. localcopyloc : tlocation;
  4348. begin
  4349. list:=TAsmList(arg);
  4350. if (tsym(p).typ=paravarsym) and
  4351. (tparavarsym(p).varspez=vs_value) and
  4352. (paramanager.push_addr_param(tparavarsym(p).varspez,tparavarsym(p).vardef,current_procinfo.procdef.proccalloption)) then
  4353. begin
  4354. { we have no idea about the alignment at the caller side }
  4355. location_get_data_ref(list,tparavarsym(p).vardef,tparavarsym(p).initialloc,href,true,1);
  4356. if is_open_array(tparavarsym(p).vardef) or
  4357. is_array_of_const(tparavarsym(p).vardef) then
  4358. begin
  4359. { cdecl functions don't have a high pointer so it is not possible to generate
  4360. a local copy }
  4361. if not(current_procinfo.procdef.proccalloption in cdecl_pocalls) then
  4362. begin
  4363. if paramanager.push_high_param(tparavarsym(p).varspez,tparavarsym(p).vardef,current_procinfo.procdef.proccalloption) then
  4364. begin
  4365. hsym:=tparavarsym(get_high_value_sym(tparavarsym(p)));
  4366. if not assigned(hsym) then
  4367. internalerror(2011020506);
  4368. highloc:=hsym.initialloc
  4369. end
  4370. else
  4371. highloc.loc:=LOC_INVALID;
  4372. hreg:=getaddressregister(list,voidpointertype);
  4373. if not is_packed_array(tparavarsym(p).vardef) then
  4374. g_copyvaluepara_openarray(list,href,highloc,tarraydef(tparavarsym(p).vardef),hreg)
  4375. else
  4376. internalerror(2011020507);
  4377. // cg.g_copyvaluepara_packedopenarray(list,href,hsym.intialloc,tarraydef(tparavarsym(p).vardef).elepackedbitsize,hreg);
  4378. a_load_reg_loc(list,tparavarsym(p).vardef,tparavarsym(p).vardef,hreg,tparavarsym(p).initialloc);
  4379. end;
  4380. end
  4381. else
  4382. begin
  4383. { Allocate space for the local copy }
  4384. l:=tparavarsym(p).getsize;
  4385. localcopyloc.loc:=LOC_REFERENCE;
  4386. localcopyloc.size:=int_cgsize(l);
  4387. tg.GetLocal(list,l,tparavarsym(p).vardef,localcopyloc.reference);
  4388. { Copy data }
  4389. if is_shortstring(tparavarsym(p).vardef) then
  4390. begin
  4391. { this code is only executed before the code for the body and the entry/exit code is generated
  4392. so we're allowed to include pi_do_call here; after pass1 is run, this isn't allowed anymore
  4393. }
  4394. include(current_procinfo.flags,pi_do_call);
  4395. g_copyshortstring(list,href,localcopyloc.reference,tstringdef(tparavarsym(p).vardef))
  4396. end
  4397. else if tparavarsym(p).vardef.typ=variantdef then
  4398. begin
  4399. { this code is only executed before the code for the body and the entry/exit code is generated
  4400. so we're allowed to include pi_do_call here; after pass1 is run, this isn't allowed anymore
  4401. }
  4402. include(current_procinfo.flags,pi_do_call);
  4403. g_copyvariant(list,href,localcopyloc.reference,tvariantdef(tparavarsym(p).vardef))
  4404. end
  4405. else
  4406. begin
  4407. { pass proper alignment info }
  4408. localcopyloc.reference.alignment:=tparavarsym(p).vardef.alignment;
  4409. g_concatcopy(list,tparavarsym(p).vardef,href,localcopyloc.reference);
  4410. end;
  4411. { update localloc of varsym }
  4412. tg.Ungetlocal(list,tparavarsym(p).localloc.reference);
  4413. tparavarsym(p).localloc:=localcopyloc;
  4414. tparavarsym(p).initialloc:=localcopyloc;
  4415. end;
  4416. end;
  4417. end;
  4418. procedure thlcgobj.gen_loadfpu_loc_cgpara(list: TAsmList; size: tdef; const l: tlocation; const cgpara: tcgpara; locintsize: longint);
  4419. var
  4420. tmploc: tlocation;
  4421. begin
  4422. case l.loc of
  4423. LOC_MMREGISTER,
  4424. LOC_CMMREGISTER:
  4425. case cgpara.location^.loc of
  4426. LOC_REFERENCE,
  4427. LOC_CREFERENCE,
  4428. LOC_MMREGISTER,
  4429. LOC_CMMREGISTER,
  4430. LOC_REGISTER,
  4431. LOC_CREGISTER :
  4432. a_loadmm_reg_cgpara(list,size,l.register,cgpara,mms_movescalar);
  4433. LOC_FPUREGISTER,
  4434. LOC_CFPUREGISTER:
  4435. begin
  4436. tmploc:=l;
  4437. location_force_fpureg(list,tmploc,size,false);
  4438. a_loadfpu_reg_cgpara(list,size,tmploc.register,cgpara);
  4439. end;
  4440. else
  4441. internalerror(200204249);
  4442. end;
  4443. LOC_FPUREGISTER,
  4444. LOC_CFPUREGISTER:
  4445. case cgpara.location^.loc of
  4446. LOC_MMREGISTER,
  4447. LOC_CMMREGISTER:
  4448. begin
  4449. tmploc:=l;
  4450. location_force_mmregscalar(list,tmploc,size,false);
  4451. a_loadmm_reg_cgpara(list,size,tmploc.register,cgpara,mms_movescalar);
  4452. end;
  4453. { Some targets pass floats in normal registers }
  4454. LOC_REGISTER,
  4455. LOC_CREGISTER,
  4456. LOC_REFERENCE,
  4457. LOC_CREFERENCE,
  4458. LOC_FPUREGISTER,
  4459. LOC_CFPUREGISTER:
  4460. a_loadfpu_reg_cgpara(list,size,l.register,cgpara);
  4461. else
  4462. internalerror(2011010210);
  4463. end;
  4464. LOC_REFERENCE,
  4465. LOC_CREFERENCE:
  4466. case cgpara.location^.loc of
  4467. LOC_MMREGISTER,
  4468. LOC_CMMREGISTER:
  4469. a_loadmm_ref_cgpara(list,size,l.reference,cgpara,mms_movescalar);
  4470. { Some targets pass floats in normal registers }
  4471. LOC_REGISTER,
  4472. LOC_CREGISTER,
  4473. LOC_REFERENCE,
  4474. LOC_CREFERENCE,
  4475. LOC_FPUREGISTER,
  4476. LOC_CFPUREGISTER:
  4477. a_loadfpu_ref_cgpara(list,size,l.reference,cgpara);
  4478. else
  4479. internalerror(2011010211);
  4480. end;
  4481. LOC_REGISTER,
  4482. LOC_CREGISTER :
  4483. a_load_loc_cgpara(list,size,l,cgpara);
  4484. else
  4485. internalerror(2011010212);
  4486. end;
  4487. end;
  4488. procedure thlcgobj.gen_load_uninitialized_function_result(list: TAsmList; pd: tprocdef; resdef: tdef; const resloc: tcgpara);
  4489. begin
  4490. { do nothing by default }
  4491. end;
  4492. procedure thlcgobj.gen_load_loc_cgpara(list: TAsmList; vardef: tdef; const l: tlocation; const cgpara: tcgpara);
  4493. begin
  4494. { Handle Floating point types differently
  4495. This doesn't depend on emulator settings, emulator settings should
  4496. be handled by cpupara }
  4497. if (vardef.typ=floatdef) or
  4498. { some ABIs return certain records in an fpu register }
  4499. (l.loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER]) or
  4500. (assigned(cgpara.location) and
  4501. (cgpara.Location^.loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER])) then
  4502. begin
  4503. gen_loadfpu_loc_cgpara(list,vardef,l,cgpara,vardef.size);
  4504. exit;
  4505. end;
  4506. case l.loc of
  4507. LOC_CONSTANT,
  4508. LOC_REGISTER,
  4509. LOC_CREGISTER,
  4510. LOC_REFERENCE,
  4511. LOC_CREFERENCE :
  4512. begin
  4513. a_load_loc_cgpara(list,vardef,l,cgpara);
  4514. end;
  4515. LOC_MMREGISTER,
  4516. LOC_CMMREGISTER:
  4517. begin
  4518. if use_vectorfpu(vardef) then
  4519. a_loadmm_loc_cgpara(list,vardef,l,cgpara,mms_movescalar)
  4520. else
  4521. { no vector support yet }
  4522. internalerror(2012071212);
  4523. {
  4524. cg.a_loadmm_loc_cgpara(list,l,cgpara,nil);
  4525. }
  4526. end;
  4527. else
  4528. internalerror(2011010213);
  4529. end;
  4530. end;
  4531. procedure thlcgobj.gen_load_cgpara_loc(list: TAsmList; vardef: tdef; const para: TCGPara; var destloc: tlocation; reusepara: boolean);
  4532. var
  4533. href : treference;
  4534. begin
  4535. para.check_simple_location;
  4536. { skip e.g. empty records }
  4537. if (para.location^.loc = LOC_VOID) then
  4538. exit;
  4539. case destloc.loc of
  4540. LOC_REFERENCE :
  4541. begin
  4542. { If the parameter location is reused we don't need to copy
  4543. anything }
  4544. if not reusepara then
  4545. begin
  4546. case para.location^.loc of
  4547. LOC_REFERENCE,LOC_CREFERENCE:
  4548. begin
  4549. reference_reset_base(href,voidstackpointertype,para.location^.reference.index,para.location^.reference.offset,para.alignment);
  4550. a_load_ref_ref(list,para.def,para.def,href,destloc.reference);
  4551. end;
  4552. else
  4553. internalerror(2013102301);
  4554. end;
  4555. end;
  4556. end;
  4557. { TODO other possible locations }
  4558. else
  4559. internalerror(2011010308);
  4560. end;
  4561. end;
  4562. procedure thlcgobj.gen_load_return_value(list: TAsmList);
  4563. var
  4564. ressym : tabstractnormalvarsym;
  4565. funcretloc : TCGPara;
  4566. retdef : tdef;
  4567. begin
  4568. { Is the loading needed? }
  4569. if is_void(current_procinfo.procdef.returndef) or
  4570. (
  4571. (po_assembler in current_procinfo.procdef.procoptions) and
  4572. (not(assigned(current_procinfo.procdef.funcretsym)) or
  4573. (tabstractvarsym(current_procinfo.procdef.funcretsym).refs=0) or
  4574. (po_nostackframe in current_procinfo.procdef.procoptions))
  4575. ) then
  4576. exit;
  4577. funcretloc:=current_procinfo.procdef.funcretloc[calleeside];
  4578. { constructors return self }
  4579. if (current_procinfo.procdef.proctypeoption=potype_constructor) then
  4580. begin
  4581. ressym:=tabstractnormalvarsym(current_procinfo.procdef.parast.Find('self'));
  4582. retdef:=ressym.vardef;
  4583. { and TP-style constructors return a pointer to self }
  4584. if is_object(ressym.vardef) then
  4585. retdef:=getpointerdef(retdef);
  4586. end
  4587. else
  4588. begin
  4589. ressym:=tabstractnormalvarsym(current_procinfo.procdef.funcretsym);
  4590. retdef:=ressym.vardef;
  4591. end;
  4592. if (ressym.refs>0) or
  4593. is_managed_type(retdef) then
  4594. begin
  4595. { was: don't do anything if funcretloc.loc in [LOC_INVALID,LOC_REFERENCE] }
  4596. if not paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef) then
  4597. gen_load_loc_cgpara(list,retdef,ressym.localloc,funcretloc);
  4598. end
  4599. else
  4600. gen_load_uninitialized_function_result(list,current_procinfo.procdef,retdef,funcretloc)
  4601. end;
  4602. procedure thlcgobj.record_generated_code_for_procdef(pd: tprocdef; code, data: TAsmList);
  4603. begin
  4604. { add the procedure to the al_procedures }
  4605. maybe_new_object_file(current_asmdata.asmlists[al_procedures]);
  4606. new_section(current_asmdata.asmlists[al_procedures],sec_code,lower(pd.mangledname),getprocalign);
  4607. current_asmdata.asmlists[al_procedures].concatlist(code);
  4608. { save local data (casetable) also in the same file }
  4609. if assigned(data) and
  4610. (not data.empty) then
  4611. current_asmdata.asmlists[al_procedures].concatlist(data);
  4612. end;
  4613. function thlcgobj.g_call_system_proc(list: TAsmList; const procname: string; forceresdef: tdef): tcgpara;
  4614. var
  4615. pd: tprocdef;
  4616. begin
  4617. pd:=search_system_proc(procname);
  4618. result:=g_call_system_proc_intern(list,pd,forceresdef);
  4619. end;
  4620. function thlcgobj.g_call_system_proc(list: TAsmList; pd: tprocdef; forceresdef: tdef): tcgpara;
  4621. begin
  4622. { separate non-virtual routine to make it clear that the routine to
  4623. override, if any, is g_call_system_proc_intern (and that none of
  4624. the g_call_system_proc variants should be made virtual) }
  4625. result:=g_call_system_proc_intern(list,pd,forceresdef);
  4626. end;
  4627. function thlcgobj.g_call_system_proc_intern(list: TAsmList; pd: tprocdef; forceresdef: tdef): tcgpara;
  4628. begin
  4629. allocallcpuregisters(list);
  4630. result:=a_call_name(list,pd,pd.mangledname,forceresdef,false);
  4631. deallocallcpuregisters(list);
  4632. end;
  4633. end.