1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983 |
- {
- Copyright (c) 1998-2005 by Florian Klaempfl
- Member of the Free Pascal development team
- This unit implements the basic code generator object
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- ****************************************************************************
- }
- {# @abstract(Abstract code generator unit)
- Abstreact code generator unit. This contains the base class
- to implement for all new supported processors.
- WARNING: None of the routines implemented in these modules,
- or their descendants, should use the temp. allocator, as
- these routines may be called inside genentrycode, and the
- stack frame is already setup!
- }
- unit cgobj;
- {$i fpcdefs.inc}
- interface
- uses
- globtype,constexp,
- cpubase,cgbase,cgutils,parabase,
- aasmbase,aasmtai,aasmdata,aasmcpu,
- symconst,symtype,symdef,rgobj
- ;
- type
- talignment = (AM_NATURAL,AM_NONE,AM_2BYTE,AM_4BYTE,AM_8BYTE);
- {# @abstract(Abstract code generator)
- This class implements an abstract instruction generator. Some of
- the methods of this class are generic, while others must
- be overridden for all new processors which will be supported
- by Free Pascal. For 32-bit processors, the base class
- should be @link(tcg64f32) and not @var(tcg).
- }
- { tcg }
- tcg = class
- { how many times is this current code executed }
- executionweight : longint;
- alignment : talignment;
- rg : array[tregistertype] of trgobj;
- {$ifdef flowgraph}
- aktflownode:word;
- {$endif}
- {************************************************}
- { basic routines }
- constructor create;
- {# Initialize the register allocators needed for the codegenerator.}
- procedure init_register_allocators;virtual;
- {# Clean up the register allocators needed for the codegenerator.}
- procedure done_register_allocators;virtual;
- {# 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. }
- procedure set_regalloc_live_range_direction(dir: TRADirection);
- {$ifdef flowgraph}
- procedure init_flowgraph;
- procedure done_flowgraph;
- {$endif}
- {# Gets a register suitable to do integer operations on.}
- function getintregister(list:TAsmList;size:Tcgsize):Tregister;virtual;
- {# Gets a register suitable to do integer operations on.}
- function getaddressregister(list:TAsmList):Tregister;virtual;
- function getfpuregister(list:TAsmList;size:Tcgsize):Tregister;virtual;
- function getmmregister(list:TAsmList;size:Tcgsize):Tregister;virtual;
- function getflagregister(list:TAsmList;size:Tcgsize):Tregister;virtual;
- {Does the generic cg need SIMD registers, like getmmxregister? Or should
- the cpu specific child cg object have such a method?}
- procedure add_reg_instruction(instr:Tai;r:tregister);virtual;
- procedure add_move_instruction(instr:Taicpu);virtual;
- function uses_registers(rt:Tregistertype):boolean;virtual;
- {# Get a specific register.}
- procedure getcpuregister(list:TAsmList;r:Tregister);virtual;
- procedure ungetcpuregister(list:TAsmList;r:Tregister);virtual;
- {# Get multiple registers specified.}
- procedure alloccpuregisters(list:TAsmList;rt:Tregistertype;const r:Tcpuregisterset);virtual;
- {# Free multiple registers specified.}
- procedure dealloccpuregisters(list:TAsmList;rt:Tregistertype;const r:Tcpuregisterset);virtual;
- procedure allocallcpuregisters(list:TAsmList);virtual;
- procedure deallocallcpuregisters(list:TAsmList);virtual;
- procedure do_register_allocation(list:TAsmList;headertai:tai);virtual;
- procedure translate_register(var reg : tregister);
- function makeregsize(list:TAsmList;reg:Tregister;size:Tcgsize):Tregister;
- {# Emit a label to the instruction stream. }
- procedure a_label(list : TAsmList;l : tasmlabel);virtual;
- {# Allocates register r by inserting a pai_realloc record }
- procedure a_reg_alloc(list : TAsmList;r : tregister);
- {# Deallocates register r by inserting a pa_regdealloc record}
- procedure a_reg_dealloc(list : TAsmList;r : tregister);
- { Synchronize register, make sure it is still valid }
- procedure a_reg_sync(list : TAsmList;r : tregister);
- {# Pass a parameter, which is located in a register, to a routine.
- This routine should push/send the parameter to the routine, as
- required by the specific processor ABI and routine modifiers.
- It must generate register allocation information for the cgpara in
- case it consists of cpuregisters.
- @param(size size of the operand in the register)
- @param(r register source of the operand)
- @param(cgpara where the parameter will be stored)
- }
- procedure a_load_reg_cgpara(list : TAsmList;size : tcgsize;r : tregister;const cgpara : TCGPara);virtual;
- {# Pass a parameter, which is a constant, to a routine.
- A generic version is provided. This routine should
- be overridden for optimization purposes if the cpu
- permits directly sending this type of parameter.
- It must generate register allocation information for the cgpara in
- case it consists of cpuregisters.
- @param(size size of the operand in constant)
- @param(a value of constant to send)
- @param(cgpara where the parameter will be stored)
- }
- procedure a_load_const_cgpara(list : TAsmList;size : tcgsize;a : tcgint;const cgpara : TCGPara);virtual;
- {# Pass the value of a parameter, which is located in memory, to a routine.
- A generic version is provided. This routine should
- be overridden for optimization purposes if the cpu
- permits directly sending this type of parameter.
- It must generate register allocation information for the cgpara in
- case it consists of cpuregisters.
- @param(size size of the operand in constant)
- @param(r Memory reference of value to send)
- @param(cgpara where the parameter will be stored)
- }
- procedure a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const cgpara : TCGPara);virtual;
- {# Pass the value of a parameter, which can be located either in a register or memory location,
- to a routine.
- A generic version is provided.
- @param(l location of the operand to send)
- @param(nr parameter number (starting from one) of routine (from left to right))
- @param(cgpara where the parameter will be stored)
- }
- procedure a_load_loc_cgpara(list : TAsmList;const l : tlocation;const cgpara : TCGPara);
- {# Pass the address of a reference to a routine. This routine
- will calculate the address of the reference, and pass this
- calculated address as a parameter.
- It must generate register allocation information for the cgpara in
- case it consists of cpuregisters.
- A generic version is provided. This routine should
- be overridden for optimization purposes if the cpu
- permits directly sending this type of parameter.
- @param(r reference to get address from)
- @param(nr parameter number (starting from one) of routine (from left to right))
- }
- procedure a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const cgpara : TCGPara);virtual;
- {# Load a cgparaloc into a memory reference.
- It must generate register allocation information for the cgpara in
- case it consists of cpuregisters.
- @param(paraloc the source parameter sublocation)
- @param(ref the destination reference)
- @param(sizeleft indicates the total number of bytes left in all of
- the remaining sublocations of this parameter (the current
- sublocation and all of the sublocations coming after it).
- In case this location is also a reference, it is assumed
- to be the final part sublocation of the parameter and that it
- contains all of the "sizeleft" bytes).)
- @param(align the alignment of the paraloc in case it's a reference)
- }
- procedure a_load_cgparaloc_ref(list : TAsmList;const paraloc : TCGParaLocation;const ref : treference;sizeleft : tcgint;align : longint);
- {# Load a cgparaloc into any kind of register (int, fp, mm).
- @param(regsize the size of the destination register)
- @param(paraloc the source parameter sublocation)
- @param(reg the destination register)
- @param(align the alignment of the paraloc in case it's a reference)
- }
- procedure a_load_cgparaloc_anyreg(list : TAsmList;regsize : tcgsize;const paraloc : TCGParaLocation;reg : tregister;align : longint);
- { Remarks:
- * If a method specifies a size you have only to take care
- of that number of bits, i.e. load_const_reg with OP_8 must
- only load the lower 8 bit of the specified register
- the rest of the register can be undefined
- if necessary the compiler will call a method
- to zero or sign extend the register
- * The a_load_XX_XX with OP_64 needn't to be
- implemented for 32 bit
- processors, the code generator takes care of that
- * the addr size is for work with the natural pointer
- size
- * the procedures without fpu/mm are only for integer usage
- * normally the first location is the source and the
- second the destination
- }
- {# Emits instruction to call the method specified by symbol name.
- This routine must be overridden for each new target cpu.
- }
- procedure a_call_name(list : TAsmList;const s : string; weak: boolean);virtual; abstract;
- procedure a_call_reg(list : TAsmList;reg : tregister);virtual; abstract;
- { same as a_call_name, might be overridden on certain architectures to emit
- static calls without usage of a got trampoline }
- procedure a_call_name_static(list : TAsmList;const s : string);virtual;
- { move instructions }
- procedure a_load_const_reg(list : TAsmList;size : tcgsize;a : tcgint;register : tregister);virtual; abstract;
- procedure a_load_const_ref(list : TAsmList;size : tcgsize;a : tcgint;const ref : treference);virtual;
- procedure a_load_const_loc(list : TAsmList;a : tcgint;const loc : tlocation);
- procedure a_load_reg_ref(list : TAsmList;fromsize,tosize : tcgsize;register : tregister;const ref : treference);virtual; abstract;
- procedure a_load_reg_ref_unaligned(list : TAsmList;fromsize,tosize : tcgsize;register : tregister;const ref : treference);virtual;
- procedure a_load_reg_reg(list : TAsmList;fromsize,tosize : tcgsize;reg1,reg2 : tregister);virtual; abstract;
- procedure a_load_reg_loc(list : TAsmList;fromsize : tcgsize;reg : tregister;const loc: tlocation);
- procedure a_load_ref_reg(list : TAsmList;fromsize,tosize : tcgsize;const ref : treference;register : tregister);virtual; abstract;
- procedure a_load_ref_reg_unaligned(list : TAsmList;fromsize,tosize : tcgsize;const ref : treference;register : tregister);virtual;
- procedure a_load_ref_ref(list : TAsmList;fromsize,tosize : tcgsize;const sref : treference;const dref : treference);virtual;
- procedure a_load_loc_reg(list : TAsmList;tosize: tcgsize; const loc: tlocation; reg : tregister);
- procedure a_load_loc_ref(list : TAsmList;tosize: tcgsize; const loc: tlocation; const ref : treference);
- procedure a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);virtual; abstract;
- { bit scan instructions }
- procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: tcgsize; src, dst: TRegister); virtual;
- { Multiplication with doubling result size.
- dstlo or dsthi may be NR_NO, in which case corresponding half of result is discarded. }
- procedure a_mul_reg_reg_pair(list: TAsmList; size: tcgsize; src1,src2,dstlo,dsthi: TRegister);virtual;
- { fpu move instructions }
- procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize:tcgsize; reg1, reg2: tregister); virtual; abstract;
- procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister); virtual; abstract;
- procedure a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference); virtual; abstract;
- procedure a_loadfpu_ref_ref(list: TAsmList; fromsize, tosize: tcgsize; const ref1,ref2: treference);
- procedure a_loadfpu_loc_reg(list: TAsmList; tosize: tcgsize; const loc: tlocation; const reg: tregister);
- procedure a_loadfpu_reg_loc(list: TAsmList; fromsize: tcgsize; const reg: tregister; const loc: tlocation);
- procedure a_loadfpu_reg_cgpara(list : TAsmList;size : tcgsize;const r : tregister;const cgpara : TCGPara);virtual;
- procedure a_loadfpu_ref_cgpara(list : TAsmList;size : tcgsize;const ref : treference;const cgpara : TCGPara);virtual;
- { vector register move instructions }
- procedure a_loadmm_reg_reg(list: TAsmList; fromsize, tosize : tcgsize;reg1, reg2: tregister;shuffle : pmmshuffle); virtual;
- procedure a_loadmm_ref_reg(list: TAsmList; fromsize, tosize : tcgsize;const ref: treference; reg: tregister;shuffle : pmmshuffle); virtual;
- procedure a_loadmm_reg_ref(list: TAsmList; fromsize, tosize : tcgsize;reg: tregister; const ref: treference;shuffle : pmmshuffle); virtual;
- procedure a_loadmm_loc_reg(list: TAsmList; size: tcgsize; const loc: tlocation; const reg: tregister;shuffle : pmmshuffle);
- procedure a_loadmm_reg_loc(list: TAsmList; size: tcgsize; const reg: tregister; const loc: tlocation;shuffle : pmmshuffle);
- procedure a_loadmm_reg_cgpara(list: TAsmList; size: tcgsize; reg: tregister;const cgpara : TCGPara;shuffle : pmmshuffle); virtual;
- procedure a_loadmm_ref_cgpara(list: TAsmList; size: tcgsize; const ref: treference;const cgpara : TCGPara;shuffle : pmmshuffle); virtual;
- procedure a_loadmm_loc_cgpara(list: TAsmList; const loc: tlocation; const cgpara : TCGPara;shuffle : pmmshuffle); virtual;
- procedure a_opmm_reg_reg(list: TAsmList; Op: TOpCG; size : tcgsize;src,dst: tregister;shuffle : pmmshuffle); virtual;
- procedure a_opmm_ref_reg(list: TAsmList; Op: TOpCG; size : tcgsize;const ref: treference; reg: tregister;shuffle : pmmshuffle); virtual;
- procedure a_opmm_loc_reg(list: TAsmList; Op: TOpCG; size : tcgsize;const loc: tlocation; reg: tregister;shuffle : pmmshuffle); virtual;
- procedure a_opmm_reg_ref(list: TAsmList; Op: TOpCG; size : tcgsize;reg: tregister;const ref: treference; shuffle : pmmshuffle); virtual;
- procedure a_opmm_loc_reg_reg(list: TAsmList;Op : TOpCG;size : tcgsize;const loc : tlocation;src,dst : tregister;shuffle : pmmshuffle); virtual;
- procedure a_opmm_reg_reg_reg(list: TAsmList; Op: TOpCG; size : tcgsize;src1,src2,dst: tregister;shuffle : pmmshuffle); virtual;
- procedure a_opmm_ref_reg_reg(list: TAsmList; Op: TOpCG; size : tcgsize;const ref: treference; src,dst: tregister;shuffle : pmmshuffle); virtual;
- procedure a_loadmm_intreg_reg(list: TAsmList; fromsize, tosize : tcgsize; intreg, mmreg: tregister; shuffle: pmmshuffle); virtual;
- procedure a_loadmm_reg_intreg(list: TAsmList; fromsize, tosize : tcgsize; mmreg, intreg: tregister; shuffle : pmmshuffle); virtual;
- { basic arithmetic operations }
- { note: for operators which require only one argument (not, neg), use }
- { the op_reg_reg, op_reg_ref or op_reg_loc methods and keep in mind }
- { that in this case the *second* operand is used as both source and }
- { destination (JM) }
- procedure a_op_const_reg(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; reg: TRegister); virtual; abstract;
- procedure a_op_const_ref(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; const ref: TReference); virtual;
- procedure a_op_const_loc(list : TAsmList; Op: TOpCG; a: tcgint; const loc: tlocation);
- procedure a_op_reg_reg(list : TAsmList; Op: TOpCG; size: TCGSize; reg1, reg2: TRegister); virtual; abstract;
- procedure a_op_reg_ref(list : TAsmList; Op: TOpCG; size: TCGSize; reg: TRegister; const ref: TReference); virtual;
- procedure a_op_ref_reg(list : TAsmList; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister); virtual;
- procedure a_op_reg_loc(list : TAsmList; Op: TOpCG; reg: tregister; const loc: tlocation);
- procedure a_op_ref_loc(list : TAsmList; Op: TOpCG; const ref: TReference; const loc: tlocation);
- { trinary operations for processors that support them, 'emulated' }
- { on others. None with "ref" arguments since I don't think there }
- { are any processors that support it (JM) }
- procedure a_op_const_reg_reg(list: TAsmList; op: TOpCg; size: tcgsize; a: tcgint; src, dst: tregister); virtual;
- procedure a_op_reg_reg_reg(list: TAsmList; op: TOpCg; size: tcgsize; src1, src2, dst: tregister); virtual;
- procedure a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; a: tcgint; src, dst: tregister;setflags : boolean;var ovloc : tlocation); virtual;
- procedure a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; src1, src2, dst: tregister;setflags : boolean;var ovloc : tlocation); virtual;
- { comparison operations }
- procedure a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;reg : tregister;
- l : tasmlabel); virtual;
- procedure a_cmp_const_ref_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;const ref : treference;
- l : tasmlabel); virtual;
- procedure a_cmp_const_loc_label(list: TAsmList; size: tcgsize;cmp_op: topcmp; a: tcgint; const loc: tlocation;
- l : tasmlabel);
- procedure a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); virtual; abstract;
- procedure a_cmp_ref_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp; const ref: treference; reg : tregister; l : tasmlabel); virtual;
- procedure a_cmp_reg_ref_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg : tregister; const ref: treference; l : tasmlabel); virtual;
- procedure a_cmp_loc_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp; const loc: tlocation; reg : tregister; l : tasmlabel);
- procedure a_cmp_reg_loc_label(list : TAsmList;size : tcgsize;cmp_op : topcmp; reg: tregister; const loc: tlocation; l : tasmlabel);
- procedure a_cmp_ref_loc_label(list: TAsmList; size: tcgsize;cmp_op: topcmp; const ref: treference; const loc: tlocation;
- l : tasmlabel);
- procedure a_jmp_name(list : TAsmList;const s : string); virtual; abstract;
- procedure a_jmp_always(list : TAsmList;l: tasmlabel); virtual; abstract;
- {$ifdef cpuflags}
- procedure a_jmp_flags(list : TAsmList;const f : TResFlags;l: tasmlabel); virtual; abstract;
- {# Depending on the value to check in the flags, either sets the register reg to one (if the flag is set)
- or zero (if the flag is cleared). The size parameter indicates the destination size register.
- }
- procedure g_flags2reg(list: TAsmList; size: TCgSize; const f: tresflags; reg: TRegister); virtual; abstract;
- procedure g_flags2ref(list: TAsmList; size: TCgSize; const f: tresflags; const ref:TReference); virtual;
- {$endif cpuflags}
- {
- This routine tries to optimize the op_const_reg/ref opcode, and should be
- called at the start of a_op_const_reg/ref. It returns the actual opcode
- to emit, and the constant value to emit. This function can opcode OP_NONE to
- remove the opcode and OP_MOVE to replace it with a simple load
- @param(size Size of the operand in constant)
- @param(op The opcode to emit, returns the opcode which must be emitted)
- @param(a The constant which should be emitted, returns the constant which must
- be emitted)
- }
- procedure optimize_op_const(size: TCGSize; var op: topcg; var a : tcgint);virtual;
- {#
- This routine is used in exception management nodes. It should
- save the exception reason currently in the FUNCTION_RETURN_REG. The
- save should be done either to a temp (pointed to by href).
- or on the stack (pushing the value on the stack).
- The size of the value to save is OS_S32. The default version
- saves the exception reason to a temp. memory area.
- }
- procedure g_exception_reason_save(list : TAsmList; const href : treference);virtual;
- {#
- This routine is used in exception management nodes. It should
- save the exception reason constant. The
- save should be done either to a temp (pointed to by href).
- or on the stack (pushing the value on the stack).
- The size of the value to save is OS_S32. The default version
- saves the exception reason to a temp. memory area.
- }
- procedure g_exception_reason_save_const(list : TAsmList; const href : treference; a: tcgint);virtual;
- {#
- This routine is used in exception management nodes. It should
- load the exception reason to the FUNCTION_RETURN_REG. The saved value
- should either be in the temp. area (pointed to by href , href should
- *NOT* be freed) or on the stack (the value should be popped).
- The size of the value to save is OS_S32. The default version
- saves the exception reason to a temp. memory area.
- }
- procedure g_exception_reason_load(list : TAsmList; const href : treference);virtual;
- procedure g_maybe_testvmt(list : TAsmList;reg:tregister;objdef:tobjectdef);
- {# This should emit the opcode to copy len bytes from the source
- to destination.
- It must be overridden for each new target processor.
- @param(source Source reference of copy)
- @param(dest Destination reference of copy)
- }
- procedure g_concatcopy(list : TAsmList;const source,dest : treference;len : tcgint);virtual; abstract;
- {# This should emit the opcode to copy len bytes from the an unaligned source
- to destination.
- It must be overridden for each new target processor.
- @param(source Source reference of copy)
- @param(dest Destination reference of copy)
- }
- procedure g_concatcopy_unaligned(list : TAsmList;const source,dest : treference;len : tcgint);virtual;
- {# Generates overflow checking code for a node }
- procedure g_overflowcheck(list: TAsmList; const Loc:tlocation; def:tdef); virtual;abstract;
- procedure g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;ovloc : tlocation);virtual;
- {# Emits instructions when compilation is done in profile
- mode (this is set as a command line option). The default
- behavior does nothing, should be overridden as required.
- }
- procedure g_profilecode(list : TAsmList);virtual;
- {# Emits instruction for allocating @var(size) bytes at the stackpointer
- @param(size Number of bytes to allocate)
- }
- procedure g_stackpointer_alloc(list : TAsmList;size : longint);virtual;
- {# Emits instruction for allocating the locals in entry
- code of a routine. This is one of the first
- routine called in @var(genentrycode).
- @param(localsize Number of bytes to allocate as locals)
- }
- procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean);virtual; abstract;
- {# Emits instructions for returning from a subroutine.
- Should also restore the framepointer and stack.
- @param(parasize Number of bytes of parameters to deallocate from stack)
- }
- procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean);virtual;abstract;
- {# This routine is called when generating the code for the entry point
- of a routine. It should save all registers which are not used in this
- routine, and which should be declared as saved in the std_saved_registers
- set.
- This routine is mainly used when linking to code which is generated
- by ABI-compliant compilers (like GCC), to make sure that the reserved
- registers of that ABI are not clobbered.
- @param(usedinproc Registers which are used in the code of this routine)
- }
- procedure g_save_registers(list:TAsmList);virtual;
- {# This routine is called when generating the code for the exit point
- of a routine. It should restore all registers which were previously
- saved in @var(g_save_standard_registers).
- @param(usedinproc Registers which are used in the code of this routine)
- }
- procedure g_restore_registers(list:TAsmList);virtual;
- procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);virtual;abstract;
- procedure g_adjust_self_value(list:TAsmList;procdef: tprocdef;ioffset: tcgint);virtual;
- { generate a stub which only purpose is to pass control the given external method,
- setting up any additional environment before doing so (if required).
- The default implementation issues a jump instruction to the external name. }
- procedure g_external_wrapper(list : TAsmList; procdef: tprocdef; const externalname: string); virtual;
- { initialize the pic/got register }
- procedure g_maybe_got_init(list: TAsmList); virtual;
- { allocallcpuregisters, a_call_name, deallocallcpuregisters sequence }
- procedure g_call(list: TAsmList; const s: string);
- { Generate code to exit an unwind-protected region. The default implementation
- produces a simple jump to destination label. }
- procedure g_local_unwind(list: TAsmList; l: TAsmLabel);virtual;
- { Generate code for integer division by constant,
- generic version is suitable for 3-address CPUs }
- procedure g_div_const_reg_reg(list:tasmlist; size: TCgSize; a: tcgint; src,dst: tregister); virtual;
- protected
- function g_indirect_sym_load(list:TAsmList;const symname: string; const flags: tindsymflags): tregister;virtual;
- end;
- {$ifdef cpu64bitalu}
- { This class implements an abstract code generator class
- for 128 Bit operations, it applies currently only to 64 Bit CPUs and supports only simple operations
- }
- tcg128 = class
- procedure a_load128_reg_reg(list : TAsmList;regsrc,regdst : tregister128);virtual;
- procedure a_load128_reg_ref(list : TAsmList;reg : tregister128;const ref : treference);virtual;
- procedure a_load128_ref_reg(list : TAsmList;const ref : treference;reg : tregister128);virtual;
- procedure a_load128_loc_ref(list : TAsmList;const l : tlocation;const ref : treference);virtual;
- procedure a_load128_reg_loc(list : TAsmList;reg : tregister128;const l : tlocation);virtual;
- procedure a_load128_const_reg(list : TAsmList;valuelo,valuehi : int64;reg : tregister128);virtual;
- procedure a_load128_loc_cgpara(list : TAsmList;const l : tlocation;const paraloc : TCGPara);virtual;
- procedure a_load128_ref_cgpara(list: TAsmList; const r: treference;const paraloc: tcgpara);
- procedure a_load128_reg_cgpara(list: TAsmList; reg: tregister128;const paraloc: tcgpara);
- end;
- { Creates a tregister128 record from 2 64 Bit registers. }
- function joinreg128(reglo,reghi : tregister) : tregister128;
- {$else cpu64bitalu}
- {# @abstract(Abstract code generator for 64 Bit operations)
- This class implements an abstract code generator class
- for 64 Bit operations.
- }
- tcg64 = class
- procedure a_load64_const_ref(list : TAsmList;value : int64;const ref : treference);virtual;abstract;
- procedure a_load64_reg_ref(list : TAsmList;reg : tregister64;const ref : treference);virtual;abstract;
- procedure a_load64_ref_reg(list : TAsmList;const ref : treference;reg : tregister64);virtual;abstract;
- procedure a_load64_reg_reg(list : TAsmList;regsrc,regdst : tregister64);virtual;abstract;
- procedure a_load64_const_reg(list : TAsmList;value : int64;reg : tregister64);virtual;abstract;
- procedure a_load64_loc_reg(list : TAsmList;const l : tlocation;reg : tregister64);virtual;abstract;
- procedure a_load64_loc_ref(list : TAsmList;const l : tlocation;const ref : treference);virtual;abstract;
- procedure a_load64_const_loc(list : TAsmList;value : int64;const l : tlocation);virtual;abstract;
- procedure a_load64_reg_loc(list : TAsmList;reg : tregister64;const l : tlocation);virtual;abstract;
- procedure a_load64_subsetref_reg(list : TAsmList; const sref: tsubsetreference; destreg: tregister64);virtual;abstract;
- procedure a_load64_reg_subsetref(list : TAsmList; fromreg: tregister64; const sref: tsubsetreference);virtual;abstract;
- procedure a_load64_const_subsetref(list: TAsmlist; a: int64; const sref: tsubsetreference);virtual;abstract;
- procedure a_load64_ref_subsetref(list : TAsmList; const fromref: treference; const sref: tsubsetreference);virtual;abstract;
- procedure a_load64_subsetref_subsetref(list: TAsmlist; const fromsref, tosref: tsubsetreference); virtual;abstract;
- procedure a_load64_subsetref_ref(list : TAsmList; const sref: tsubsetreference; const destref: treference); virtual;abstract;
- procedure a_load64_loc_subsetref(list : TAsmList; const l: tlocation; const sref : tsubsetreference);
- procedure a_load64_subsetref_loc(list: TAsmlist; const sref: tsubsetreference; const l: tlocation);
- procedure a_load64high_reg_ref(list : TAsmList;reg : tregister;const ref : treference);virtual;abstract;
- procedure a_load64low_reg_ref(list : TAsmList;reg : tregister;const ref : treference);virtual;abstract;
- procedure a_load64high_ref_reg(list : TAsmList;const ref : treference;reg : tregister);virtual;abstract;
- procedure a_load64low_ref_reg(list : TAsmList;const ref : treference;reg : tregister);virtual;abstract;
- procedure a_load64high_loc_reg(list : TAsmList;const l : tlocation;reg : tregister);virtual;abstract;
- procedure a_load64low_loc_reg(list : TAsmList;const l : tlocation;reg : tregister);virtual;abstract;
- procedure a_op64_ref_reg(list : TAsmList;op:TOpCG;size : tcgsize;const ref : treference;reg : tregister64);virtual;abstract;
- procedure a_op64_reg_reg(list : TAsmList;op:TOpCG;size : tcgsize;regsrc,regdst : tregister64);virtual;abstract;
- procedure a_op64_reg_ref(list : TAsmList;op:TOpCG;size : tcgsize;regsrc : tregister64;const ref : treference);virtual;abstract;
- procedure a_op64_const_reg(list : TAsmList;op:TOpCG;size : tcgsize;value : int64;regdst : tregister64);virtual;abstract;
- procedure a_op64_const_ref(list : TAsmList;op:TOpCG;size : tcgsize;value : int64;const ref : treference);virtual;abstract;
- procedure a_op64_const_loc(list : TAsmList;op:TOpCG;size : tcgsize;value : int64;const l: tlocation);virtual;abstract;
- procedure a_op64_reg_loc(list : TAsmList;op:TOpCG;size : tcgsize;reg : tregister64;const l : tlocation);virtual;abstract;
- procedure a_op64_loc_reg(list : TAsmList;op:TOpCG;size : tcgsize;const l : tlocation;reg64 : tregister64);virtual;abstract;
- procedure a_op64_const_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64);virtual;
- procedure a_op64_reg_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64);virtual;
- procedure a_op64_const_reg_reg_checkoverflow(list: TAsmList;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64;setflags : boolean;var ovloc : tlocation);virtual;
- procedure a_op64_reg_reg_reg_checkoverflow(list: TAsmList;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64;setflags : boolean;var ovloc : tlocation);virtual;
- procedure a_op64_const_subsetref(list : TAsmList; Op : TOpCG; size : TCGSize; a : int64; const sref: tsubsetreference);
- procedure a_op64_reg_subsetref(list : TAsmList; Op : TOpCG; size : TCGSize; reg: tregister64; const sref: tsubsetreference);
- procedure a_op64_ref_subsetref(list : TAsmList; Op : TOpCG; size : TCGSize; const ref: treference; const sref: tsubsetreference);
- procedure a_op64_subsetref_subsetref(list : TAsmList; Op : TOpCG; size : TCGSize; const ssref,dsref: tsubsetreference);
- procedure a_load64_reg_cgpara(list : TAsmList;reg64 : tregister64;const loc : TCGPara);virtual;abstract;
- procedure a_load64_const_cgpara(list : TAsmList;value : int64;const loc : TCGPara);virtual;abstract;
- procedure a_load64_ref_cgpara(list : TAsmList;const r : treference;const loc : TCGPara);virtual;abstract;
- procedure a_load64_loc_cgpara(list : TAsmList;const l : tlocation;const loc : TCGPara);virtual;abstract;
- procedure a_loadmm_intreg64_reg(list: TAsmList; mmsize: tcgsize; intreg: tregister64; mmreg: tregister); virtual;abstract;
- procedure a_loadmm_reg_intreg64(list: TAsmList; mmsize: tcgsize; mmreg: tregister; intreg: tregister64); virtual;abstract;
- {
- This routine tries to optimize the const_reg opcode, and should be
- called at the start of a_op64_const_reg. It returns the actual opcode
- to emit, and the constant value to emit. If this routine returns
- TRUE, @var(no) instruction should be emitted (.eg : imul reg by 1 )
- @param(op The opcode to emit, returns the opcode which must be emitted)
- @param(a The constant which should be emitted, returns the constant which must
- be emitted)
- @param(reg The register to emit the opcode with, returns the register with
- which the opcode will be emitted)
- }
- function optimize64_op_const_reg(list: TAsmList; var op: topcg; var a : int64; var reg: tregister64): boolean;virtual;abstract;
- { override to catch 64bit rangechecks }
- procedure g_rangecheck64(list: TAsmList; const l:tlocation; fromdef,todef: tdef);virtual;abstract;
- end;
- { Creates a tregister64 record from 2 32 Bit registers. }
- function joinreg64(reglo,reghi : tregister) : tregister64;
- {$endif cpu64bitalu}
- var
- { Main code generator class }
- cg : tcg;
- {$ifdef cpu64bitalu}
- { Code generator class for all operations working with 128-Bit operands }
- cg128 : tcg128;
- {$else cpu64bitalu}
- { Code generator class for all operations working with 64-Bit operands }
- cg64 : tcg64;
- {$endif cpu64bitalu}
- function asmsym2indsymflags(sym: TAsmSymbol): tindsymflags;
- procedure destroy_codegen;
- implementation
- uses
- globals,systems,
- verbose,paramgr,symtable,symsym,
- tgobj,cutils,procinfo;
- {*****************************************************************************
- basic functionallity
- ******************************************************************************}
- constructor tcg.create;
- begin
- end;
- {*****************************************************************************
- register allocation
- ******************************************************************************}
- procedure tcg.init_register_allocators;
- begin
- fillchar(rg,sizeof(rg),0);
- add_reg_instruction_hook:=@add_reg_instruction;
- executionweight:=1;
- end;
- procedure tcg.done_register_allocators;
- begin
- { Safety }
- fillchar(rg,sizeof(rg),0);
- add_reg_instruction_hook:=nil;
- end;
- {$ifdef flowgraph}
- procedure Tcg.init_flowgraph;
- begin
- aktflownode:=0;
- end;
- procedure Tcg.done_flowgraph;
- begin
- end;
- {$endif}
- function tcg.getintregister(list:TAsmList;size:Tcgsize):Tregister;
- begin
- if not assigned(rg[R_INTREGISTER]) then
- internalerror(200312122);
- result:=rg[R_INTREGISTER].getregister(list,cgsize2subreg(R_INTREGISTER,size));
- end;
- function tcg.getfpuregister(list:TAsmList;size:Tcgsize):Tregister;
- begin
- if not assigned(rg[R_FPUREGISTER]) then
- internalerror(200312123);
- result:=rg[R_FPUREGISTER].getregister(list,cgsize2subreg(R_FPUREGISTER,size));
- end;
- function tcg.getmmregister(list:TAsmList;size:Tcgsize):Tregister;
- begin
- if not assigned(rg[R_MMREGISTER]) then
- internalerror(2003121214);
- result:=rg[R_MMREGISTER].getregister(list,cgsize2subreg(R_MMREGISTER,size));
- end;
- function tcg.getaddressregister(list:TAsmList):Tregister;
- begin
- if assigned(rg[R_ADDRESSREGISTER]) then
- result:=rg[R_ADDRESSREGISTER].getregister(list,R_SUBWHOLE)
- else
- begin
- if not assigned(rg[R_INTREGISTER]) then
- internalerror(200312121);
- result:=rg[R_INTREGISTER].getregister(list,R_SUBWHOLE);
- end;
- end;
- function Tcg.makeregsize(list:TAsmList;reg:Tregister;size:Tcgsize):Tregister;
- var
- subreg:Tsubregister;
- begin
- subreg:=cgsize2subreg(getregtype(reg),size);
- result:=reg;
- setsubreg(result,subreg);
- { notify RA }
- if result<>reg then
- list.concat(tai_regalloc.resize(result));
- end;
- procedure tcg.getcpuregister(list:TAsmList;r:Tregister);
- begin
- if not assigned(rg[getregtype(r)]) then
- internalerror(200312125);
- rg[getregtype(r)].getcpuregister(list,r);
- end;
- procedure tcg.ungetcpuregister(list:TAsmList;r:Tregister);
- begin
- if not assigned(rg[getregtype(r)]) then
- internalerror(200312126);
- rg[getregtype(r)].ungetcpuregister(list,r);
- end;
- procedure tcg.alloccpuregisters(list:TAsmList;rt:Tregistertype;const r:Tcpuregisterset);
- begin
- if assigned(rg[rt]) then
- rg[rt].alloccpuregisters(list,r)
- else
- internalerror(200310092);
- end;
- procedure tcg.allocallcpuregisters(list:TAsmList);
- begin
- alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
- if uses_registers(R_ADDRESSREGISTER) then
- alloccpuregisters(list,R_ADDRESSREGISTER,paramanager.get_volatile_registers_address(pocall_default));
- {$if not(defined(i386)) and not(defined(i8086)) and not(defined(avr))}
- if uses_registers(R_FPUREGISTER) then
- alloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
- {$ifdef cpumm}
- if uses_registers(R_MMREGISTER) then
- alloccpuregisters(list,R_MMREGISTER,paramanager.get_volatile_registers_mm(pocall_default));
- {$endif cpumm}
- {$endif not(defined(i386)) and not(defined(i8086)) and not(defined(avr))}
- end;
- procedure tcg.dealloccpuregisters(list:TAsmList;rt:Tregistertype;const r:Tcpuregisterset);
- begin
- if assigned(rg[rt]) then
- rg[rt].dealloccpuregisters(list,r)
- else
- internalerror(200310093);
- end;
- procedure tcg.deallocallcpuregisters(list:TAsmList);
- begin
- dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
- if uses_registers(R_ADDRESSREGISTER) then
- dealloccpuregisters(list,R_ADDRESSREGISTER,paramanager.get_volatile_registers_address(pocall_default));
- {$if not(defined(i386)) and not(defined(i8086)) and not(defined(avr))}
- if uses_registers(R_FPUREGISTER) then
- dealloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
- {$ifdef cpumm}
- if uses_registers(R_MMREGISTER) then
- dealloccpuregisters(list,R_MMREGISTER,paramanager.get_volatile_registers_mm(pocall_default));
- {$endif cpumm}
- {$endif not(defined(i386)) and not(defined(i8086)) and not(defined(avr))}
- end;
- function tcg.uses_registers(rt:Tregistertype):boolean;
- begin
- if assigned(rg[rt]) then
- result:=rg[rt].uses_registers
- else
- result:=false;
- end;
- procedure tcg.add_reg_instruction(instr:Tai;r:tregister);
- var
- rt : tregistertype;
- begin
- rt:=getregtype(r);
- { Only add it when a register allocator is configured.
- No IE can be generated, because the VMT is written
- without a valid rg[] }
- if assigned(rg[rt]) then
- rg[rt].add_reg_instruction(instr,r,executionweight);
- end;
- procedure tcg.add_move_instruction(instr:Taicpu);
- var
- rt : tregistertype;
- begin
- rt:=getregtype(instr.oper[O_MOV_SOURCE]^.reg);
- if assigned(rg[rt]) then
- rg[rt].add_move_instruction(instr)
- else
- internalerror(200310095);
- end;
- procedure tcg.set_regalloc_live_range_direction(dir: TRADirection);
- var
- rt : tregistertype;
- begin
- for rt:=low(rg) to high(rg) do
- begin
- if assigned(rg[rt]) then
- rg[rt].live_range_direction:=dir;
- end;
- end;
- procedure tcg.do_register_allocation(list:TAsmList;headertai:tai);
- var
- rt : tregistertype;
- begin
- for rt:=R_FPUREGISTER to R_SPECIALREGISTER do
- begin
- if assigned(rg[rt]) then
- rg[rt].do_register_allocation(list,headertai);
- end;
- { running the other register allocator passes could require addition int/addr. registers
- when spilling so run int/addr register allocation at the end }
- if assigned(rg[R_INTREGISTER]) then
- rg[R_INTREGISTER].do_register_allocation(list,headertai);
- if assigned(rg[R_ADDRESSREGISTER]) then
- rg[R_ADDRESSREGISTER].do_register_allocation(list,headertai);
- end;
- procedure tcg.translate_register(var reg : tregister);
- begin
- rg[getregtype(reg)].translate_register(reg);
- end;
- procedure tcg.a_reg_alloc(list : TAsmList;r : tregister);
- begin
- list.concat(tai_regalloc.alloc(r,nil));
- end;
- procedure tcg.a_reg_dealloc(list : TAsmList;r : tregister);
- begin
- list.concat(tai_regalloc.dealloc(r,nil));
- end;
- procedure tcg.a_reg_sync(list : TAsmList;r : tregister);
- var
- instr : tai;
- begin
- instr:=tai_regalloc.sync(r);
- list.concat(instr);
- add_reg_instruction(instr,r);
- end;
- procedure tcg.a_label(list : TAsmList;l : tasmlabel);
- begin
- list.concat(tai_label.create(l));
- end;
- {*****************************************************************************
- for better code generation these methods should be overridden
- ******************************************************************************}
- procedure tcg.a_load_reg_cgpara(list : TAsmList;size : tcgsize;r : tregister;const cgpara : TCGPara);
- var
- ref : treference;
- tmpreg : tregister;
- begin
- cgpara.check_simple_location;
- paramanager.alloccgpara(list,cgpara);
- if cgpara.location^.shiftval<0 then
- begin
- tmpreg:=getintregister(list,cgpara.location^.size);
- a_op_const_reg_reg(list,OP_SHL,cgpara.location^.size,-cgpara.location^.shiftval,r,tmpreg);
- r:=tmpreg;
- end;
- case cgpara.location^.loc of
- LOC_REGISTER,LOC_CREGISTER:
- a_load_reg_reg(list,size,cgpara.location^.size,r,cgpara.location^.register);
- LOC_REFERENCE,LOC_CREFERENCE:
- begin
- reference_reset_base(ref,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment);
- a_load_reg_ref(list,size,cgpara.location^.size,r,ref);
- end;
- LOC_MMREGISTER,LOC_CMMREGISTER:
- a_loadmm_intreg_reg(list,size,cgpara.location^.size,r,cgpara.location^.register,mms_movescalar);
- LOC_FPUREGISTER,LOC_CFPUREGISTER:
- begin
- tg.GetTemp(list,TCGSize2Size[size],TCGSize2Size[size],tt_normal,ref);
- a_load_reg_ref(list,size,size,r,ref);
- a_loadfpu_ref_cgpara(list,cgpara.location^.size,ref,cgpara);
- tg.Ungettemp(list,ref);
- end
- else
- internalerror(2002071004);
- end;
- end;
- procedure tcg.a_load_const_cgpara(list : TAsmList;size : tcgsize;a : tcgint;const cgpara : TCGPara);
- var
- ref : treference;
- begin
- cgpara.check_simple_location;
- paramanager.alloccgpara(list,cgpara);
- if cgpara.location^.shiftval<0 then
- a:=a shl -cgpara.location^.shiftval;
- case cgpara.location^.loc of
- LOC_REGISTER,LOC_CREGISTER:
- a_load_const_reg(list,cgpara.location^.size,a,cgpara.location^.register);
- LOC_REFERENCE,LOC_CREFERENCE:
- begin
- reference_reset_base(ref,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment);
- a_load_const_ref(list,cgpara.location^.size,a,ref);
- end
- else
- internalerror(2010053109);
- end;
- end;
- procedure tcg.a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const cgpara : TCGPara);
- var
- tmpref, ref: treference;
- tmpreg: tregister;
- location: pcgparalocation;
- orgsizeleft,
- sizeleft: tcgint;
- reghasvalue: boolean;
- begin
- location:=cgpara.location;
- tmpref:=r;
- sizeleft:=cgpara.intsize;
- while assigned(location) do
- begin
- paramanager.allocparaloc(list,location);
- case location^.loc of
- LOC_REGISTER,LOC_CREGISTER:
- begin
- { Parameter locations are often allocated in multiples of
- entire registers. If a parameter only occupies a part of
- such a register (e.g. a 16 bit int on a 32 bit
- architecture), the size of this parameter can only be
- determined by looking at the "size" parameter of this
- method -> if the size parameter is <= sizeof(aint), then
- we check that there is only one parameter location and
- then use this "size" to load the value into the parameter
- location }
- if (size<>OS_NO) and
- (tcgsize2size[size]<=sizeof(aint)) then
- begin
- cgpara.check_simple_location;
- a_load_ref_reg(list,size,location^.size,tmpref,location^.register);
- if location^.shiftval<0 then
- a_op_const_reg(list,OP_SHL,location^.size,-location^.shiftval,location^.register);
- end
- { there's a lot more data left, and the current paraloc's
- register is entirely filled with part of that data }
- else if (sizeleft>sizeof(aint)) then
- begin
- a_load_ref_reg(list,location^.size,location^.size,tmpref,location^.register);
- end
- { we're at the end of the data, and it can be loaded into
- the current location's register with a single regular
- load }
- else if sizeleft in [1,2,4,8] then
- begin
- a_load_ref_reg(list,int_cgsize(sizeleft),location^.size,tmpref,location^.register);
- if location^.shiftval<0 then
- a_op_const_reg(list,OP_SHL,location^.size,-location^.shiftval,location^.register);
- end
- { we're at the end of the data, and we need multiple loads
- to get it in the register because it's an irregular size }
- else
- begin
- { should be the last part }
- if assigned(location^.next) then
- internalerror(2010052907);
- { load the value piecewise to get it into the register }
- orgsizeleft:=sizeleft;
- reghasvalue:=false;
- {$ifdef cpu64bitalu}
- if sizeleft>=4 then
- begin
- a_load_ref_reg(list,OS_32,location^.size,tmpref,location^.register);
- dec(sizeleft,4);
- if target_info.endian=endian_big then
- a_op_const_reg(list,OP_SHL,location^.size,sizeleft*8,location^.register);
- inc(tmpref.offset,4);
- reghasvalue:=true;
- end;
- {$endif cpu64bitalu}
- if sizeleft>=2 then
- begin
- tmpreg:=getintregister(list,location^.size);
- a_load_ref_reg(list,OS_16,location^.size,tmpref,tmpreg);
- dec(sizeleft,2);
- if reghasvalue then
- begin
- if target_info.endian=endian_big then
- a_op_const_reg(list,OP_SHL,location^.size,sizeleft*8,tmpreg)
- else
- a_op_const_reg(list,OP_SHL,location^.size,(orgsizeleft-(sizeleft+2))*8,tmpreg);
- a_op_reg_reg(list,OP_OR,location^.size,tmpreg,location^.register);
- end
- else
- begin
- if target_info.endian=endian_big then
- a_op_const_reg_reg(list,OP_SHL,location^.size,sizeleft*8,tmpreg,location^.register)
- else
- a_load_reg_reg(list,location^.size,location^.size,tmpreg,location^.register);
- end;
- inc(tmpref.offset,2);
- reghasvalue:=true;
- end;
- if sizeleft=1 then
- begin
- tmpreg:=getintregister(list,location^.size);
- a_load_ref_reg(list,OS_8,location^.size,tmpref,tmpreg);
- dec(sizeleft,1);
- if reghasvalue then
- begin
- if target_info.endian=endian_little then
- a_op_const_reg(list,OP_SHL,location^.size,(orgsizeleft-(sizeleft+1))*8,tmpreg);
- a_op_reg_reg(list,OP_OR,location^.size,tmpreg,location^.register)
- end
- else
- a_load_reg_reg(list,location^.size,location^.size,tmpreg,location^.register);
- inc(tmpref.offset);
- end;
- if location^.shiftval<0 then
- a_op_const_reg(list,OP_SHL,location^.size,-location^.shiftval,location^.register);
- { the loop will already adjust the offset and sizeleft }
- dec(tmpref.offset,orgsizeleft);
- sizeleft:=orgsizeleft;
- end;
- end;
- LOC_REFERENCE,LOC_CREFERENCE:
- begin
- if assigned(location^.next) then
- internalerror(2010052906);
- reference_reset_base(ref,location^.reference.index,location^.reference.offset,newalignment(cgpara.alignment,cgpara.intsize-sizeleft));
- if (size <> OS_NO) and
- (tcgsize2size[size] <= sizeof(aint)) then
- a_load_ref_ref(list,size,location^.size,tmpref,ref)
- else
- { use concatcopy, because the parameter can be larger than }
- { what the OS_* constants can handle }
- g_concatcopy(list,tmpref,ref,sizeleft);
- end;
- LOC_MMREGISTER,LOC_CMMREGISTER:
- begin
- case location^.size of
- OS_F32,
- OS_F64,
- OS_F128:
- a_loadmm_ref_reg(list,location^.size,location^.size,tmpref,location^.register,mms_movescalar);
- OS_M8..OS_M128,
- OS_MS8..OS_MS128:
- a_loadmm_ref_reg(list,location^.size,location^.size,tmpref,location^.register,nil);
- else
- internalerror(2010053101);
- end;
- end
- else
- internalerror(2010053111);
- end;
- inc(tmpref.offset,tcgsize2size[location^.size]);
- dec(sizeleft,tcgsize2size[location^.size]);
- location:=location^.next;
- end;
- end;
- procedure tcg.a_load_loc_cgpara(list : TAsmList;const l:tlocation;const cgpara : TCGPara);
- begin
- case l.loc of
- LOC_REGISTER,
- LOC_CREGISTER :
- a_load_reg_cgpara(list,l.size,l.register,cgpara);
- LOC_CONSTANT :
- a_load_const_cgpara(list,l.size,l.value,cgpara);
- LOC_CREFERENCE,
- LOC_REFERENCE :
- a_load_ref_cgpara(list,l.size,l.reference,cgpara);
- else
- internalerror(2002032211);
- end;
- end;
- procedure tcg.a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const cgpara : TCGPara);
- var
- hr : tregister;
- begin
- cgpara.check_simple_location;
- if cgpara.location^.loc in [LOC_CREGISTER,LOC_REGISTER] then
- begin
- paramanager.allocparaloc(list,cgpara.location);
- a_loadaddr_ref_reg(list,r,cgpara.location^.register)
- end
- else
- begin
- hr:=getaddressregister(list);
- a_loadaddr_ref_reg(list,r,hr);
- a_load_reg_cgpara(list,OS_ADDR,hr,cgpara);
- end;
- end;
- procedure tcg.a_load_cgparaloc_ref(list : TAsmList;const paraloc : TCGParaLocation;const ref : treference;sizeleft : tcgint;align : longint);
- var
- href : treference;
- hreg : tregister;
- cgsize: tcgsize;
- begin
- case paraloc.loc of
- LOC_REGISTER :
- begin
- hreg:=paraloc.register;
- cgsize:=paraloc.size;
- if paraloc.shiftval>0 then
- a_op_const_reg_reg(list,OP_SHL,OS_INT,paraloc.shiftval,paraloc.register,paraloc.register)
- else if (paraloc.shiftval<0) and
- (sizeleft in [1,2,4]) then
- begin
- a_op_const_reg_reg(list,OP_SHR,OS_INT,-paraloc.shiftval,paraloc.register,paraloc.register);
- { convert to a register of 1/2/4 bytes in size, since the
- original register had to be made larger to be able to hold
- the shifted value }
- cgsize:=int_cgsize(tcgsize2size[OS_INT]-(-paraloc.shiftval div 8));
- hreg:=getintregister(list,cgsize);
- a_load_reg_reg(list,OS_INT,cgsize,paraloc.register,hreg);
- end;
- a_load_reg_ref(list,paraloc.size,cgsize,hreg,ref);
- end;
- LOC_MMREGISTER :
- begin
- case paraloc.size of
- OS_F32,
- OS_F64,
- OS_F128:
- a_loadmm_reg_ref(list,paraloc.size,paraloc.size,paraloc.register,ref,mms_movescalar);
- OS_M8..OS_M128,
- OS_MS8..OS_MS128:
- a_loadmm_reg_ref(list,paraloc.size,paraloc.size,paraloc.register,ref,nil);
- else
- internalerror(2010053102);
- end;
- end;
- LOC_FPUREGISTER :
- a_loadfpu_reg_ref(list,paraloc.size,paraloc.size,paraloc.register,ref);
- LOC_REFERENCE :
- begin
- reference_reset_base(href,paraloc.reference.index,paraloc.reference.offset,align);
- { use concatcopy, because it can also be a float which fails when
- load_ref_ref is used. Don't copy data when the references are equal }
- if not((href.base=ref.base) and (href.offset=ref.offset)) then
- g_concatcopy(list,href,ref,sizeleft);
- end;
- else
- internalerror(2002081302);
- end;
- end;
- procedure tcg.a_load_cgparaloc_anyreg(list: TAsmList;regsize: tcgsize;const paraloc: TCGParaLocation;reg: tregister;align: longint);
- var
- href : treference;
- begin
- case paraloc.loc of
- LOC_REGISTER :
- begin
- if paraloc.shiftval<0 then
- a_op_const_reg_reg(list,OP_SHR,OS_INT,-paraloc.shiftval,paraloc.register,paraloc.register);
- case getregtype(reg) of
- R_ADDRESSREGISTER,
- R_INTREGISTER:
- a_load_reg_reg(list,paraloc.size,regsize,paraloc.register,reg);
- R_MMREGISTER:
- a_loadmm_intreg_reg(list,paraloc.size,regsize,paraloc.register,reg,mms_movescalar);
- else
- internalerror(2009112422);
- end;
- end;
- LOC_MMREGISTER :
- begin
- case getregtype(reg) of
- R_ADDRESSREGISTER,
- R_INTREGISTER:
- a_loadmm_reg_intreg(list,paraloc.size,regsize,paraloc.register,reg,mms_movescalar);
- R_MMREGISTER:
- begin
- case paraloc.size of
- OS_F32,
- OS_F64,
- OS_F128:
- a_loadmm_reg_reg(list,paraloc.size,regsize,paraloc.register,reg,mms_movescalar);
- OS_M8..OS_M128,
- OS_MS8..OS_MS128:
- a_loadmm_reg_reg(list,paraloc.size,paraloc.size,paraloc.register,reg,nil);
- else
- internalerror(2010053102);
- end;
- end;
- else
- internalerror(2010053104);
- end;
- end;
- LOC_FPUREGISTER :
- a_loadfpu_reg_reg(list,paraloc.size,regsize,paraloc.register,reg);
- LOC_REFERENCE :
- begin
- reference_reset_base(href,paraloc.reference.index,paraloc.reference.offset,align);
- case getregtype(reg) of
- R_ADDRESSREGISTER,
- R_INTREGISTER :
- a_load_ref_reg(list,paraloc.size,regsize,href,reg);
- R_FPUREGISTER :
- a_loadfpu_ref_reg(list,paraloc.size,regsize,href,reg);
- R_MMREGISTER :
- { not paraloc.size, because it may be OS_64 instead of
- OS_F64 in case the parameter is passed using integer
- conventions (e.g., on ARM) }
- a_loadmm_ref_reg(list,regsize,regsize,href,reg,mms_movescalar);
- else
- internalerror(2004101012);
- end;
- end;
- else
- internalerror(2002081302);
- end;
- end;
- {****************************************************************************
- some generic implementations
- ****************************************************************************}
- { memory/register loading }
- procedure tcg.a_load_reg_ref_unaligned(list : TAsmList;fromsize,tosize : tcgsize;register : tregister;const ref : treference);
- var
- tmpref : treference;
- tmpreg : tregister;
- i : longint;
- begin
- if ref.alignment<tcgsize2size[fromsize] then
- begin
- tmpref:=ref;
- { we take care of the alignment now }
- tmpref.alignment:=0;
- case FromSize of
- OS_16,OS_S16:
- begin
- tmpreg:=getintregister(list,OS_16);
- a_load_reg_reg(list,fromsize,OS_16,register,tmpreg);
- if target_info.endian=endian_big then
- inc(tmpref.offset);
- tmpreg:=makeregsize(list,tmpreg,OS_8);
- a_load_reg_ref(list,OS_8,OS_8,tmpreg,tmpref);
- tmpreg:=makeregsize(list,tmpreg,OS_16);
- a_op_const_reg(list,OP_SHR,OS_16,8,tmpreg);
- if target_info.endian=endian_big then
- dec(tmpref.offset)
- else
- inc(tmpref.offset);
- tmpreg:=makeregsize(list,tmpreg,OS_8);
- a_load_reg_ref(list,OS_8,OS_8,tmpreg,tmpref);
- end;
- OS_32,OS_S32:
- begin
- { could add an optimised case for ref.alignment=2 }
- tmpreg:=getintregister(list,OS_32);
- a_load_reg_reg(list,fromsize,OS_32,register,tmpreg);
- if target_info.endian=endian_big then
- inc(tmpref.offset,3);
- tmpreg:=makeregsize(list,tmpreg,OS_8);
- a_load_reg_ref(list,OS_8,OS_8,tmpreg,tmpref);
- tmpreg:=makeregsize(list,tmpreg,OS_32);
- for i:=1 to 3 do
- begin
- a_op_const_reg(list,OP_SHR,OS_32,8,tmpreg);
- if target_info.endian=endian_big then
- dec(tmpref.offset)
- else
- inc(tmpref.offset);
- tmpreg:=makeregsize(list,tmpreg,OS_8);
- a_load_reg_ref(list,OS_8,OS_8,tmpreg,tmpref);
- tmpreg:=makeregsize(list,tmpreg,OS_32);
- end;
- end
- else
- a_load_reg_ref(list,fromsize,tosize,register,tmpref);
- end;
- end
- else
- a_load_reg_ref(list,fromsize,tosize,register,ref);
- end;
- procedure tcg.a_load_ref_reg_unaligned(list : TAsmList;fromsize,tosize : tcgsize;const ref : treference;register : tregister);
- var
- tmpref : treference;
- tmpreg,
- tmpreg2 : tregister;
- i : longint;
- hisize : tcgsize;
- begin
- if ref.alignment in [1,2] then
- begin
- tmpref:=ref;
- { we take care of the alignment now }
- tmpref.alignment:=0;
- case FromSize of
- OS_16,OS_S16:
- if ref.alignment=2 then
- a_load_ref_reg(list,fromsize,tosize,tmpref,register)
- else
- begin
- if FromSize=OS_16 then
- hisize:=OS_8
- else
- hisize:=OS_S8;
- { first load in tmpreg, because the target register }
- { may be used in ref as well }
- if target_info.endian=endian_little then
- inc(tmpref.offset);
- tmpreg:=getintregister(list,OS_8);
- a_load_ref_reg(list,hisize,hisize,tmpref,tmpreg);
- tmpreg:=makeregsize(list,tmpreg,FromSize);
- a_op_const_reg(list,OP_SHL,FromSize,8,tmpreg);
- if target_info.endian=endian_little then
- dec(tmpref.offset)
- else
- inc(tmpref.offset);
- a_load_ref_reg(list,OS_8,OS_16,tmpref,register);
- a_op_reg_reg(list,OP_OR,OS_16,tmpreg,register);
- end;
- OS_32,OS_S32:
- if ref.alignment=2 then
- begin
- if target_info.endian=endian_little then
- inc(tmpref.offset,2);
- tmpreg:=getintregister(list,OS_32);
- a_load_ref_reg(list,OS_16,OS_32,tmpref,tmpreg);
- a_op_const_reg(list,OP_SHL,OS_32,16,tmpreg);
- if target_info.endian=endian_little then
- dec(tmpref.offset,2)
- else
- inc(tmpref.offset,2);
- a_load_ref_reg(list,OS_16,OS_32,tmpref,register);
- a_op_reg_reg(list,OP_OR,OS_32,tmpreg,register);
- end
- else
- begin
- if target_info.endian=endian_little then
- inc(tmpref.offset,3);
- tmpreg:=getintregister(list,OS_32);
- a_load_ref_reg(list,OS_8,OS_32,tmpref,tmpreg);
- tmpreg2:=getintregister(list,OS_32);
- for i:=1 to 3 do
- begin
- a_op_const_reg(list,OP_SHL,OS_32,8,tmpreg);
- if target_info.endian=endian_little then
- dec(tmpref.offset)
- else
- inc(tmpref.offset);
- a_load_ref_reg(list,OS_8,OS_32,tmpref,tmpreg2);
- a_op_reg_reg(list,OP_OR,OS_32,tmpreg2,tmpreg);
- end;
- a_load_reg_reg(list,OS_32,OS_32,tmpreg,register);
- end
- else
- a_load_ref_reg(list,fromsize,tosize,tmpref,register);
- end;
- end
- else
- a_load_ref_reg(list,fromsize,tosize,ref,register);
- end;
- procedure tcg.a_load_ref_ref(list : TAsmList;fromsize,tosize : tcgsize;const sref : treference;const dref : treference);
- var
- tmpreg: tregister;
- begin
- { verify if we have the same reference }
- if references_equal(sref,dref) then
- exit;
- tmpreg:=getintregister(list,tosize);
- a_load_ref_reg(list,fromsize,tosize,sref,tmpreg);
- a_load_reg_ref(list,tosize,tosize,tmpreg,dref);
- end;
- procedure tcg.a_load_const_ref(list : TAsmList;size : tcgsize;a : tcgint;const ref : treference);
- var
- tmpreg: tregister;
- begin
- tmpreg:=getintregister(list,size);
- a_load_const_reg(list,size,a,tmpreg);
- a_load_reg_ref(list,size,size,tmpreg,ref);
- end;
- procedure tcg.a_load_const_loc(list : TAsmList;a : tcgint;const loc: tlocation);
- begin
- case loc.loc of
- LOC_REFERENCE,LOC_CREFERENCE:
- a_load_const_ref(list,loc.size,a,loc.reference);
- LOC_REGISTER,LOC_CREGISTER:
- a_load_const_reg(list,loc.size,a,loc.register);
- else
- internalerror(200203272);
- end;
- end;
- procedure tcg.a_load_reg_loc(list : TAsmList;fromsize : tcgsize;reg : tregister;const loc: tlocation);
- begin
- case loc.loc of
- LOC_REFERENCE,LOC_CREFERENCE:
- a_load_reg_ref(list,fromsize,loc.size,reg,loc.reference);
- LOC_REGISTER,LOC_CREGISTER:
- a_load_reg_reg(list,fromsize,loc.size,reg,loc.register);
- LOC_MMREGISTER,LOC_CMMREGISTER:
- a_loadmm_intreg_reg(list,fromsize,loc.size,reg,loc.register,mms_movescalar);
- else
- internalerror(200203271);
- end;
- end;
- procedure tcg.a_load_loc_reg(list : TAsmList; tosize: tcgsize; const loc: tlocation; reg : tregister);
- begin
- case loc.loc of
- LOC_REFERENCE,LOC_CREFERENCE:
- a_load_ref_reg(list,loc.size,tosize,loc.reference,reg);
- LOC_REGISTER,LOC_CREGISTER:
- a_load_reg_reg(list,loc.size,tosize,loc.register,reg);
- LOC_CONSTANT:
- a_load_const_reg(list,tosize,loc.value,reg);
- else
- internalerror(200109092);
- end;
- end;
- procedure tcg.a_load_loc_ref(list : TAsmList;tosize: tcgsize; const loc: tlocation; const ref : treference);
- begin
- case loc.loc of
- LOC_REFERENCE,LOC_CREFERENCE:
- a_load_ref_ref(list,loc.size,tosize,loc.reference,ref);
- LOC_REGISTER,LOC_CREGISTER:
- a_load_reg_ref(list,loc.size,tosize,loc.register,ref);
- LOC_CONSTANT:
- a_load_const_ref(list,tosize,loc.value,ref);
- else
- internalerror(200109302);
- end;
- end;
- procedure tcg.optimize_op_const(size: TCGSize; var op: topcg; var a : tcgint);
- var
- powerval : longint;
- signext_a, zeroext_a: tcgint;
- begin
- case size of
- OS_64,OS_S64:
- begin
- signext_a:=int64(a);
- zeroext_a:=int64(a);
- end;
- OS_32,OS_S32:
- begin
- signext_a:=longint(a);
- zeroext_a:=dword(a);
- end;
- OS_16,OS_S16:
- begin
- signext_a:=smallint(a);
- zeroext_a:=word(a);
- end;
- OS_8,OS_S8:
- begin
- signext_a:=shortint(a);
- zeroext_a:=byte(a);
- end
- else
- begin
- { Should we internalerror() here instead? }
- signext_a:=a;
- zeroext_a:=a;
- end;
- end;
- case op of
- OP_OR :
- begin
- { or with zero returns same result }
- if a = 0 then
- op:=OP_NONE
- else
- { or with max returns max }
- if signext_a = -1 then
- op:=OP_MOVE;
- end;
- OP_AND :
- begin
- { and with max returns same result }
- if (signext_a = -1) then
- op:=OP_NONE
- else
- { and with 0 returns 0 }
- if a=0 then
- op:=OP_MOVE;
- end;
- OP_DIV :
- begin
- { division by 1 returns result }
- if a = 1 then
- op:=OP_NONE
- else if ispowerof2(int64(zeroext_a), powerval) and not(cs_check_overflow in current_settings.localswitches) then
- begin
- a := powerval;
- op:= OP_SHR;
- end;
- end;
- OP_IDIV:
- begin
- if a = 1 then
- op:=OP_NONE;
- end;
- OP_MUL,OP_IMUL:
- begin
- if a = 1 then
- op:=OP_NONE
- else
- if a=0 then
- op:=OP_MOVE
- else if ispowerof2(int64(zeroext_a), powerval) and not(cs_check_overflow in current_settings.localswitches) then
- begin
- a := powerval;
- op:= OP_SHL;
- end;
- end;
- OP_ADD,OP_SUB:
- begin
- if a = 0 then
- op:=OP_NONE;
- end;
- OP_SAR,OP_SHL,OP_SHR,OP_ROL,OP_ROR:
- begin
- if a = 0 then
- op:=OP_NONE;
- end;
- end;
- end;
- procedure tcg.a_loadfpu_loc_reg(list: TAsmList; tosize: tcgsize; const loc: tlocation; const reg: tregister);
- begin
- case loc.loc of
- LOC_REFERENCE, LOC_CREFERENCE:
- a_loadfpu_ref_reg(list,loc.size,tosize,loc.reference,reg);
- LOC_FPUREGISTER, LOC_CFPUREGISTER:
- a_loadfpu_reg_reg(list,loc.size,tosize,loc.register,reg);
- else
- internalerror(200203301);
- end;
- end;
- procedure tcg.a_loadfpu_reg_loc(list: TAsmList; fromsize: tcgsize; const reg: tregister; const loc: tlocation);
- begin
- case loc.loc of
- LOC_REFERENCE, LOC_CREFERENCE:
- a_loadfpu_reg_ref(list,fromsize,loc.size,reg,loc.reference);
- LOC_FPUREGISTER, LOC_CFPUREGISTER:
- a_loadfpu_reg_reg(list,fromsize,loc.size,reg,loc.register);
- else
- internalerror(48991);
- end;
- end;
- procedure tcg.a_loadfpu_ref_ref(list: TAsmList; fromsize, tosize: tcgsize; const ref1,ref2: treference);
- var
- reg: tregister;
- regsize: tcgsize;
- begin
- if (fromsize>=tosize) then
- regsize:=fromsize
- else
- regsize:=tosize;
- reg:=getfpuregister(list,regsize);
- a_loadfpu_ref_reg(list,fromsize,regsize,ref1,reg);
- a_loadfpu_reg_ref(list,regsize,tosize,reg,ref2);
- end;
- procedure tcg.a_loadfpu_reg_cgpara(list : TAsmList;size : tcgsize;const r : tregister;const cgpara : TCGPara);
- var
- ref : treference;
- begin
- paramanager.alloccgpara(list,cgpara);
- case cgpara.location^.loc of
- LOC_FPUREGISTER,LOC_CFPUREGISTER:
- begin
- cgpara.check_simple_location;
- a_loadfpu_reg_reg(list,size,size,r,cgpara.location^.register);
- end;
- LOC_REFERENCE,LOC_CREFERENCE:
- begin
- cgpara.check_simple_location;
- reference_reset_base(ref,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment);
- a_loadfpu_reg_ref(list,size,size,r,ref);
- end;
- LOC_REGISTER,LOC_CREGISTER:
- begin
- { paramfpu_ref does the check_simpe_location check here if necessary }
- tg.GetTemp(list,TCGSize2Size[size],TCGSize2Size[size],tt_normal,ref);
- a_loadfpu_reg_ref(list,size,size,r,ref);
- a_loadfpu_ref_cgpara(list,size,ref,cgpara);
- tg.Ungettemp(list,ref);
- end;
- else
- internalerror(2010053112);
- end;
- end;
- procedure tcg.a_loadfpu_ref_cgpara(list : TAsmList;size : tcgsize;const ref : treference;const cgpara : TCGPara);
- var
- href : treference;
- hsize: tcgsize;
- begin
- case cgpara.location^.loc of
- LOC_FPUREGISTER,LOC_CFPUREGISTER:
- begin
- cgpara.check_simple_location;
- paramanager.alloccgpara(list,cgpara);
- a_loadfpu_ref_reg(list,size,size,ref,cgpara.location^.register);
- end;
- LOC_REFERENCE,LOC_CREFERENCE:
- begin
- cgpara.check_simple_location;
- reference_reset_base(href,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment);
- { concatcopy should choose the best way to copy the data }
- g_concatcopy(list,ref,href,tcgsize2size[size]);
- end;
- LOC_REGISTER,LOC_CREGISTER:
- begin
- { force integer size }
- hsize:=int_cgsize(tcgsize2size[size]);
- {$ifndef cpu64bitalu}
- if (hsize in [OS_S64,OS_64]) then
- cg64.a_load64_ref_cgpara(list,ref,cgpara)
- else
- {$endif not cpu64bitalu}
- begin
- cgpara.check_simple_location;
- a_load_ref_cgpara(list,hsize,ref,cgpara)
- end;
- end
- else
- internalerror(200402201);
- end;
- end;
- procedure tcg.a_op_const_ref(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; const ref: TReference);
- var
- tmpreg : tregister;
- begin
- tmpreg:=getintregister(list,size);
- a_load_ref_reg(list,size,size,ref,tmpreg);
- a_op_const_reg(list,op,size,a,tmpreg);
- a_load_reg_ref(list,size,size,tmpreg,ref);
- end;
- procedure tcg.a_op_const_loc(list : TAsmList; Op: TOpCG; a: tcgint; const loc: tlocation);
- begin
- case loc.loc of
- LOC_REGISTER, LOC_CREGISTER:
- a_op_const_reg(list,op,loc.size,a,loc.register);
- LOC_REFERENCE, LOC_CREFERENCE:
- a_op_const_ref(list,op,loc.size,a,loc.reference);
- else
- internalerror(200109061);
- end;
- end;
- procedure tcg.a_op_reg_ref(list : TAsmList; Op: TOpCG; size: TCGSize;reg: TRegister; const ref: TReference);
- var
- tmpreg : tregister;
- begin
- tmpreg:=getintregister(list,size);
- a_load_ref_reg(list,size,size,ref,tmpreg);
- a_op_reg_reg(list,op,size,reg,tmpreg);
- a_load_reg_ref(list,size,size,tmpreg,ref);
- end;
- procedure tcg.a_op_ref_reg(list : TAsmList; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister);
- var
- tmpreg: tregister;
- begin
- case op of
- OP_NOT,OP_NEG:
- { handle it as "load ref,reg; op reg" }
- begin
- a_load_ref_reg(list,size,size,ref,reg);
- a_op_reg_reg(list,op,size,reg,reg);
- end;
- else
- begin
- tmpreg:=getintregister(list,size);
- a_load_ref_reg(list,size,size,ref,tmpreg);
- a_op_reg_reg(list,op,size,tmpreg,reg);
- end;
- end;
- end;
- procedure tcg.a_op_reg_loc(list : TAsmList; Op: TOpCG; reg: tregister; const loc: tlocation);
- begin
- case loc.loc of
- LOC_REGISTER, LOC_CREGISTER:
- a_op_reg_reg(list,op,loc.size,reg,loc.register);
- LOC_REFERENCE, LOC_CREFERENCE:
- a_op_reg_ref(list,op,loc.size,reg,loc.reference);
- else
- internalerror(200109061);
- end;
- end;
- procedure tcg.a_op_ref_loc(list : TAsmList; Op: TOpCG; const ref: TReference; const loc: tlocation);
- var
- tmpreg: tregister;
- begin
- case loc.loc of
- LOC_REGISTER,LOC_CREGISTER:
- a_op_ref_reg(list,op,loc.size,ref,loc.register);
- LOC_REFERENCE,LOC_CREFERENCE:
- begin
- tmpreg:=getintregister(list,loc.size);
- a_load_ref_reg(list,loc.size,loc.size,ref,tmpreg);
- a_op_reg_ref(list,op,loc.size,tmpreg,loc.reference);
- end;
- else
- internalerror(200109061);
- end;
- end;
- procedure Tcg.a_op_const_reg_reg(list:TAsmList;op:Topcg;size:Tcgsize;
- a:tcgint;src,dst:Tregister);
- begin
- a_load_reg_reg(list,size,size,src,dst);
- a_op_const_reg(list,op,size,a,dst);
- end;
- procedure tcg.a_op_reg_reg_reg(list: TAsmList; op: TOpCg;
- size: tcgsize; src1, src2, dst: tregister);
- var
- tmpreg: tregister;
- begin
- if (dst<>src1) then
- begin
- a_load_reg_reg(list,size,size,src2,dst);
- a_op_reg_reg(list,op,size,src1,dst);
- end
- else
- begin
- { can we do a direct operation on the target register ? }
- if op in [OP_ADD,OP_MUL,OP_AND,OP_MOVE,OP_XOR,OP_IMUL,OP_OR] then
- a_op_reg_reg(list,op,size,src2,dst)
- else
- begin
- tmpreg:=getintregister(list,size);
- a_load_reg_reg(list,size,size,src2,tmpreg);
- a_op_reg_reg(list,op,size,src1,tmpreg);
- a_load_reg_reg(list,size,size,tmpreg,dst);
- end;
- end;
- end;
- procedure tcg.a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; a: tcgint; src, dst: tregister;setflags : boolean;var ovloc : tlocation);
- begin
- a_op_const_reg_reg(list,op,size,a,src,dst);
- ovloc.loc:=LOC_VOID;
- end;
- procedure tcg.a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; src1, src2, dst: tregister;setflags : boolean;var ovloc : tlocation);
- begin
- a_op_reg_reg_reg(list,op,size,src1,src2,dst);
- ovloc.loc:=LOC_VOID;
- end;
- procedure tcg.a_cmp_const_reg_label(list: TAsmList; size: tcgsize;
- cmp_op: topcmp; a: tcgint; reg: tregister; l: tasmlabel);
- var
- tmpreg: tregister;
- begin
- tmpreg:=getintregister(list,size);
- a_load_const_reg(list,size,a,tmpreg);
- a_cmp_reg_reg_label(list,size,cmp_op,tmpreg,reg,l);
- end;
- procedure tcg.a_cmp_const_ref_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;const ref : treference;
- l : tasmlabel);
- var
- tmpreg: tregister;
- begin
- tmpreg:=getintregister(list,size);
- a_load_ref_reg(list,size,size,ref,tmpreg);
- a_cmp_const_reg_label(list,size,cmp_op,a,tmpreg,l);
- end;
- procedure tcg.a_cmp_const_loc_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;const loc : tlocation;
- l : tasmlabel);
- begin
- case loc.loc of
- LOC_REGISTER,LOC_CREGISTER:
- a_cmp_const_reg_label(list,size,cmp_op,a,loc.register,l);
- LOC_REFERENCE,LOC_CREFERENCE:
- a_cmp_const_ref_label(list,size,cmp_op,a,loc.reference,l);
- else
- internalerror(200109061);
- end;
- end;
- procedure tcg.a_cmp_ref_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp; const ref: treference; reg : tregister; l : tasmlabel);
- var
- tmpreg: tregister;
- begin
- tmpreg:=getintregister(list,size);
- a_load_ref_reg(list,size,size,ref,tmpreg);
- a_cmp_reg_reg_label(list,size,cmp_op,tmpreg,reg,l);
- end;
- procedure tcg.a_cmp_reg_ref_label(list : TAsmList;size : tcgsize;cmp_op : topcmp; reg : tregister; const ref: treference; l : tasmlabel);
- var
- tmpreg: tregister;
- begin
- tmpreg:=getintregister(list,size);
- a_load_ref_reg(list,size,size,ref,tmpreg);
- a_cmp_reg_reg_label(list,size,cmp_op,reg,tmpreg,l);
- end;
- procedure tcg.a_cmp_reg_loc_label(list : TAsmList;size : tcgsize;cmp_op : topcmp; reg: tregister; const loc: tlocation; l : tasmlabel);
- begin
- a_cmp_loc_reg_label(list,size,swap_opcmp(cmp_op),loc,reg,l);
- end;
- procedure tcg.a_cmp_loc_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp; const loc: tlocation; reg : tregister; l : tasmlabel);
- begin
- case loc.loc of
- LOC_REGISTER,
- LOC_CREGISTER:
- a_cmp_reg_reg_label(list,size,cmp_op,loc.register,reg,l);
- LOC_REFERENCE,
- LOC_CREFERENCE :
- a_cmp_ref_reg_label(list,size,cmp_op,loc.reference,reg,l);
- LOC_CONSTANT:
- a_cmp_const_reg_label(list,size,cmp_op,loc.value,reg,l);
- else
- internalerror(200203231);
- end;
- end;
- procedure tcg.a_cmp_ref_loc_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;const ref: treference;const loc : tlocation;
- l : tasmlabel);
- var
- tmpreg: tregister;
- begin
- case loc.loc of
- LOC_REGISTER,LOC_CREGISTER:
- a_cmp_ref_reg_label(list,size,cmp_op,ref,loc.register,l);
- LOC_REFERENCE,LOC_CREFERENCE:
- begin
- tmpreg:=getintregister(list,size);
- a_load_ref_reg(list,size,size,loc.reference,tmpreg);
- a_cmp_ref_reg_label(list,size,cmp_op,ref,tmpreg,l);
- end;
- else
- internalerror(200109061);
- end;
- end;
- procedure tcg.a_loadmm_loc_reg(list: TAsmList; size: tcgsize; const loc: tlocation; const reg: tregister;shuffle : pmmshuffle);
- begin
- case loc.loc of
- LOC_MMREGISTER,LOC_CMMREGISTER:
- a_loadmm_reg_reg(list,loc.size,size,loc.register,reg,shuffle);
- LOC_REFERENCE,LOC_CREFERENCE:
- a_loadmm_ref_reg(list,loc.size,size,loc.reference,reg,shuffle);
- LOC_REGISTER,LOC_CREGISTER:
- a_loadmm_intreg_reg(list,loc.size,size,loc.register,reg,shuffle);
- else
- internalerror(200310121);
- end;
- end;
- procedure tcg.a_loadmm_reg_loc(list: TAsmList; size: tcgsize; const reg: tregister; const loc: tlocation;shuffle : pmmshuffle);
- begin
- case loc.loc of
- LOC_MMREGISTER,LOC_CMMREGISTER:
- a_loadmm_reg_reg(list,size,loc.size,reg,loc.register,shuffle);
- LOC_REFERENCE,LOC_CREFERENCE:
- a_loadmm_reg_ref(list,size,loc.size,reg,loc.reference,shuffle);
- else
- internalerror(200310122);
- end;
- end;
- procedure tcg.a_loadmm_reg_cgpara(list: TAsmList; size: tcgsize; reg: tregister;const cgpara : TCGPara;shuffle : pmmshuffle);
- var
- href : treference;
- {$ifndef cpu64bitalu}
- tmpreg : tregister;
- reg64 : tregister64;
- {$endif not cpu64bitalu}
- begin
- {$ifndef cpu64bitalu}
- if not(cgpara.location^.loc in [LOC_REGISTER,LOC_CREGISTER]) or
- (size<>OS_F64) then
- {$endif not cpu64bitalu}
- cgpara.check_simple_location;
- paramanager.alloccgpara(list,cgpara);
- case cgpara.location^.loc of
- LOC_MMREGISTER,LOC_CMMREGISTER:
- a_loadmm_reg_reg(list,size,cgpara.location^.size,reg,cgpara.location^.register,shuffle);
- LOC_REFERENCE,LOC_CREFERENCE:
- begin
- reference_reset_base(href,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment);
- a_loadmm_reg_ref(list,size,cgpara.location^.size,reg,href,shuffle);
- end;
- LOC_REGISTER,LOC_CREGISTER:
- begin
- if assigned(shuffle) and
- not shufflescalar(shuffle) then
- internalerror(2009112510);
- {$ifndef cpu64bitalu}
- if (size=OS_F64) then
- begin
- if not assigned(cgpara.location^.next) or
- assigned(cgpara.location^.next^.next) then
- internalerror(2009112512);
- case cgpara.location^.next^.loc of
- LOC_REGISTER,LOC_CREGISTER:
- tmpreg:=cgpara.location^.next^.register;
- LOC_REFERENCE,LOC_CREFERENCE:
- tmpreg:=getintregister(list,OS_32);
- else
- internalerror(2009112910);
- end;
- if (target_info.endian=ENDIAN_BIG) then
- begin
- { paraloc^ -> high
- paraloc^.next -> low }
- reg64.reghi:=cgpara.location^.register;
- reg64.reglo:=tmpreg;
- end
- else
- begin
- { paraloc^ -> low
- paraloc^.next -> high }
- reg64.reglo:=cgpara.location^.register;
- reg64.reghi:=tmpreg;
- end;
- cg64.a_loadmm_reg_intreg64(list,size,reg,reg64);
- if (cgpara.location^.next^.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
- begin
- if not(cgpara.location^.next^.size in [OS_32,OS_S32]) then
- internalerror(2009112911);
- reference_reset_base(href,cgpara.location^.next^.reference.index,cgpara.location^.next^.reference.offset,cgpara.alignment);
- a_load_reg_ref(list,OS_32,cgpara.location^.next^.size,tmpreg,href);
- end;
- end
- else
- {$endif not cpu64bitalu}
- a_loadmm_reg_intreg(list,size,cgpara.location^.size,reg,cgpara.location^.register,mms_movescalar);
- end
- else
- internalerror(200310123);
- end;
- end;
- procedure tcg.a_loadmm_ref_cgpara(list: TAsmList; size: tcgsize;const ref: treference;const cgpara : TCGPara;shuffle : pmmshuffle);
- var
- hr : tregister;
- hs : tmmshuffle;
- begin
- cgpara.check_simple_location;
- hr:=getmmregister(list,cgpara.location^.size);
- a_loadmm_ref_reg(list,size,cgpara.location^.size,ref,hr,shuffle);
- if realshuffle(shuffle) then
- begin
- hs:=shuffle^;
- removeshuffles(hs);
- a_loadmm_reg_cgpara(list,cgpara.location^.size,hr,cgpara,@hs);
- end
- else
- a_loadmm_reg_cgpara(list,cgpara.location^.size,hr,cgpara,shuffle);
- end;
- procedure tcg.a_loadmm_loc_cgpara(list: TAsmList;const loc: tlocation; const cgpara : TCGPara;shuffle : pmmshuffle);
- begin
- case loc.loc of
- LOC_MMREGISTER,LOC_CMMREGISTER:
- a_loadmm_reg_cgpara(list,loc.size,loc.register,cgpara,shuffle);
- LOC_REFERENCE,LOC_CREFERENCE:
- a_loadmm_ref_cgpara(list,loc.size,loc.reference,cgpara,shuffle);
- else
- internalerror(200310123);
- end;
- end;
- procedure tcg.a_opmm_ref_reg(list: TAsmList; Op: TOpCG; size : tcgsize;const ref: treference; reg: tregister;shuffle : pmmshuffle);
- var
- hr : tregister;
- hs : tmmshuffle;
- begin
- hr:=getmmregister(list,size);
- a_loadmm_ref_reg(list,size,size,ref,hr,shuffle);
- if realshuffle(shuffle) then
- begin
- hs:=shuffle^;
- removeshuffles(hs);
- a_opmm_reg_reg(list,op,size,hr,reg,@hs);
- end
- else
- a_opmm_reg_reg(list,op,size,hr,reg,shuffle);
- end;
- procedure tcg.a_opmm_reg_ref(list: TAsmList; Op: TOpCG; size : tcgsize;reg: tregister; const ref: treference; shuffle : pmmshuffle);
- var
- hr : tregister;
- hs : tmmshuffle;
- begin
- hr:=getmmregister(list,size);
- a_loadmm_ref_reg(list,size,size,ref,hr,shuffle);
- if realshuffle(shuffle) then
- begin
- hs:=shuffle^;
- removeshuffles(hs);
- a_opmm_reg_reg(list,op,size,reg,hr,@hs);
- a_loadmm_reg_ref(list,size,size,hr,ref,@hs);
- end
- else
- begin
- a_opmm_reg_reg(list,op,size,reg,hr,shuffle);
- a_loadmm_reg_ref(list,size,size,hr,ref,shuffle);
- end;
- end;
- procedure tcg.a_loadmm_intreg_reg(list: tasmlist; fromsize,tosize: tcgsize; intreg,mmreg: tregister; shuffle: pmmshuffle);
- var
- tmpref: treference;
- begin
- if (tcgsize2size[fromsize]<>4) or
- (tcgsize2size[tosize]<>4) then
- internalerror(2009112503);
- tg.gettemp(list,4,4,tt_normal,tmpref);
- a_load_reg_ref(list,fromsize,fromsize,intreg,tmpref);
- a_loadmm_ref_reg(list,tosize,tosize,tmpref,mmreg,shuffle);
- tg.ungettemp(list,tmpref);
- end;
- procedure tcg.a_loadmm_reg_intreg(list: tasmlist; fromsize,tosize: tcgsize; mmreg,intreg: tregister; shuffle: pmmshuffle);
- var
- tmpref: treference;
- begin
- if (tcgsize2size[fromsize]<>4) or
- (tcgsize2size[tosize]<>4) then
- internalerror(2009112504);
- tg.gettemp(list,8,8,tt_normal,tmpref);
- a_loadmm_reg_ref(list,fromsize,fromsize,mmreg,tmpref,shuffle);
- a_load_ref_reg(list,tosize,tosize,tmpref,intreg);
- tg.ungettemp(list,tmpref);
- end;
- procedure tcg.a_opmm_loc_reg(list: TAsmList; Op: TOpCG; size : tcgsize;const loc: tlocation; reg: tregister;shuffle : pmmshuffle);
- begin
- case loc.loc of
- LOC_CMMREGISTER,LOC_MMREGISTER:
- a_opmm_reg_reg(list,op,size,loc.register,reg,shuffle);
- LOC_CREFERENCE,LOC_REFERENCE:
- a_opmm_ref_reg(list,op,size,loc.reference,reg,shuffle);
- else
- internalerror(200312232);
- end;
- end;
- procedure tcg.a_opmm_loc_reg_reg(list: TAsmList; Op: TOpCG; size : tcgsize;const loc: tlocation; src,dst: tregister;shuffle : pmmshuffle);
- begin
- case loc.loc of
- LOC_CMMREGISTER,LOC_MMREGISTER:
- a_opmm_reg_reg_reg(list,op,size,loc.register,src,dst,shuffle);
- LOC_CREFERENCE,LOC_REFERENCE:
- a_opmm_ref_reg_reg(list,op,size,loc.reference,src,dst,shuffle);
- else
- internalerror(200312232);
- end;
- end;
- procedure tcg.a_opmm_reg_reg_reg(list : TAsmList;Op : TOpCG;size : tcgsize;
- src1,src2,dst : tregister;shuffle : pmmshuffle);
- begin
- internalerror(2013061102);
- end;
- procedure tcg.a_opmm_ref_reg_reg(list : TAsmList;Op : TOpCG;size : tcgsize;
- const ref : treference;src,dst : tregister;shuffle : pmmshuffle);
- begin
- internalerror(2013061101);
- end;
- procedure tcg.g_concatcopy_unaligned(list : TAsmList;const source,dest : treference;len : tcgint);
- begin
- g_concatcopy(list,source,dest,len);
- end;
- procedure tcg.g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;ovloc : tlocation);
- begin
- g_overflowCheck(list,loc,def);
- end;
- {$ifdef cpuflags}
- procedure tcg.g_flags2ref(list: TAsmList; size: TCgSize; const f: tresflags; const ref:TReference);
- var
- tmpreg : tregister;
- begin
- tmpreg:=getintregister(list,size);
- g_flags2reg(list,size,f,tmpreg);
- a_load_reg_ref(list,size,size,tmpreg,ref);
- end;
- {$endif cpuflags}
- procedure tcg.g_maybe_testvmt(list : TAsmList;reg:tregister;objdef:tobjectdef);
- var
- hrefvmt : treference;
- cgpara1,cgpara2 : TCGPara;
- pd: tprocdef;
- begin
- cgpara1.init;
- cgpara2.init;
- if (cs_check_object in current_settings.localswitches) then
- begin
- pd:=search_system_proc('fpc_check_object_ext');
- paramanager.getintparaloc(pd,1,cgpara1);
- paramanager.getintparaloc(pd,2,cgpara2);
- reference_reset_symbol(hrefvmt,current_asmdata.RefAsmSymbol(objdef.vmt_mangledname,AT_DATA),0,sizeof(pint));
- if pd.is_pushleftright then
- begin
- a_load_reg_cgpara(list,OS_ADDR,reg,cgpara1);
- a_loadaddr_ref_cgpara(list,hrefvmt,cgpara2);
- end
- else
- begin
- a_loadaddr_ref_cgpara(list,hrefvmt,cgpara2);
- a_load_reg_cgpara(list,OS_ADDR,reg,cgpara1);
- end;
- paramanager.freecgpara(list,cgpara1);
- paramanager.freecgpara(list,cgpara2);
- allocallcpuregisters(list);
- a_call_name(list,'fpc_check_object_ext',false);
- deallocallcpuregisters(list);
- end
- else
- if (cs_check_range in current_settings.localswitches) then
- begin
- pd:=search_system_proc('fpc_check_object');
- paramanager.getintparaloc(pd,1,cgpara1);
- a_load_reg_cgpara(list,OS_ADDR,reg,cgpara1);
- paramanager.freecgpara(list,cgpara1);
- allocallcpuregisters(list);
- a_call_name(list,'fpc_check_object',false);
- deallocallcpuregisters(list);
- end;
- cgpara1.done;
- cgpara2.done;
- end;
- {*****************************************************************************
- Entry/Exit Code Functions
- *****************************************************************************}
- procedure tcg.g_save_registers(list:TAsmList);
- var
- href : treference;
- size : longint;
- r : integer;
- begin
- { calculate temp. size }
- size:=0;
- for r:=low(saved_standard_registers) to high(saved_standard_registers) do
- if saved_standard_registers[r] in rg[R_INTREGISTER].used_in_proc then
- inc(size,sizeof(aint));
- if uses_registers(R_ADDRESSREGISTER) then
- for r:=low(saved_address_registers) to high(saved_address_registers) do
- if saved_address_registers[r] in rg[R_ADDRESSREGISTER].used_in_proc then
- inc(size,sizeof(aint));
- { mm registers }
- if uses_registers(R_MMREGISTER) then
- begin
- { Make sure we reserve enough space to do the alignment based on the offset
- later on. We can't use the size for this, because the alignment of the start
- of the temp is smaller than needed for an OS_VECTOR }
- inc(size,tcgsize2size[OS_VECTOR]);
- for r:=low(saved_mm_registers) to high(saved_mm_registers) do
- if saved_mm_registers[r] in rg[R_MMREGISTER].used_in_proc then
- inc(size,tcgsize2size[OS_VECTOR]);
- end;
- if size>0 then
- begin
- tg.GetTemp(list,size,sizeof(aint),tt_noreuse,current_procinfo.save_regs_ref);
- include(current_procinfo.flags,pi_has_saved_regs);
- { Copy registers to temp }
- href:=current_procinfo.save_regs_ref;
- for r:=low(saved_standard_registers) to high(saved_standard_registers) do
- begin
- if saved_standard_registers[r] in rg[R_INTREGISTER].used_in_proc then
- begin
- a_load_reg_ref(list,OS_ADDR,OS_ADDR,newreg(R_INTREGISTER,saved_standard_registers[r],R_SUBWHOLE),href);
- inc(href.offset,sizeof(aint));
- end;
- include(rg[R_INTREGISTER].preserved_by_proc,saved_standard_registers[r]);
- end;
- if uses_registers(R_ADDRESSREGISTER) then
- for r:=low(saved_address_registers) to high(saved_address_registers) do
- begin
- if saved_address_registers[r] in rg[R_ADDRESSREGISTER].used_in_proc then
- begin
- a_load_reg_ref(list,OS_ADDR,OS_ADDR,newreg(R_ADDRESSREGISTER,saved_address_registers[r],R_SUBWHOLE),href);
- inc(href.offset,sizeof(aint));
- end;
- include(rg[R_ADDRESSREGISTER].preserved_by_proc,saved_address_registers[r]);
- end;
- if uses_registers(R_MMREGISTER) then
- begin
- if (href.offset mod tcgsize2size[OS_VECTOR])<>0 then
- inc(href.offset,tcgsize2size[OS_VECTOR]-(href.offset mod tcgsize2size[OS_VECTOR]));
- for r:=low(saved_mm_registers) to high(saved_mm_registers) do
- begin
- { the array has to be declared even if no MM registers are saved
- (such as with SSE on i386), and since 0-element arrays don't
- exist, they contain a single RS_INVALID element in that case
- }
- if saved_mm_registers[r]<>RS_INVALID then
- begin
- if saved_mm_registers[r] in rg[R_MMREGISTER].used_in_proc then
- begin
- a_loadmm_reg_ref(list,OS_VECTOR,OS_VECTOR,newreg(R_MMREGISTER,saved_mm_registers[r],R_SUBMMWHOLE),href,nil);
- inc(href.offset,tcgsize2size[OS_VECTOR]);
- end;
- include(rg[R_MMREGISTER].preserved_by_proc,saved_mm_registers[r]);
- end;
- end;
- end;
- end;
- end;
- procedure tcg.g_restore_registers(list:TAsmList);
- var
- href : treference;
- r : integer;
- hreg : tregister;
- begin
- if not(pi_has_saved_regs in current_procinfo.flags) then
- exit;
- { Copy registers from temp }
- href:=current_procinfo.save_regs_ref;
- for r:=low(saved_standard_registers) to high(saved_standard_registers) do
- if saved_standard_registers[r] in rg[R_INTREGISTER].used_in_proc then
- begin
- hreg:=newreg(R_INTREGISTER,saved_standard_registers[r],R_SUBWHOLE);
- { Allocate register so the optimizer does not remove the load }
- a_reg_alloc(list,hreg);
- a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,hreg);
- inc(href.offset,sizeof(aint));
- end;
- if uses_registers(R_ADDRESSREGISTER) then
- for r:=low(saved_address_registers) to high(saved_address_registers) do
- if saved_address_registers[r] in rg[R_ADDRESSREGISTER].used_in_proc then
- begin
- hreg:=newreg(R_ADDRESSREGISTER,saved_address_registers[r],R_SUBWHOLE);
- { Allocate register so the optimizer does not remove the load }
- a_reg_alloc(list,hreg);
- a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,hreg);
- inc(href.offset,sizeof(aint));
- end;
- if uses_registers(R_MMREGISTER) then
- begin
- if (href.offset mod tcgsize2size[OS_VECTOR])<>0 then
- inc(href.offset,tcgsize2size[OS_VECTOR]-(href.offset mod tcgsize2size[OS_VECTOR]));
- for r:=low(saved_mm_registers) to high(saved_mm_registers) do
- begin
- if saved_mm_registers[r] in rg[R_MMREGISTER].used_in_proc then
- begin
- hreg:=newreg(R_MMREGISTER,saved_mm_registers[r],R_SUBMMWHOLE);
- { Allocate register so the optimizer does not remove the load }
- a_reg_alloc(list,hreg);
- a_loadmm_ref_reg(list,OS_VECTOR,OS_VECTOR,href,hreg,nil);
- inc(href.offset,tcgsize2size[OS_VECTOR]);
- end;
- end;
- end;
- tg.UnGetTemp(list,current_procinfo.save_regs_ref);
- end;
- procedure tcg.g_profilecode(list : TAsmList);
- begin
- end;
- procedure tcg.g_exception_reason_save(list : TAsmList; const href : treference);
- begin
- a_load_reg_ref(list, OS_INT, OS_INT, NR_FUNCTION_RESULT_REG, href);
- end;
- procedure tcg.g_exception_reason_save_const(list : TAsmList; const href : treference; a: tcgint);
- begin
- a_load_const_ref(list, OS_INT, a, href);
- end;
- procedure tcg.g_exception_reason_load(list : TAsmList; const href : treference);
- begin
- a_reg_alloc(list,NR_FUNCTION_RESULT_REG);
- a_load_ref_reg(list, OS_INT, OS_INT, href, NR_FUNCTION_RESULT_REG);
- end;
- procedure tcg.g_adjust_self_value(list:TAsmList;procdef: tprocdef;ioffset: tcgint);
- var
- hsym : tsym;
- href : treference;
- paraloc : Pcgparalocation;
- begin
- { calculate the parameter info for the procdef }
- procdef.init_paraloc_info(callerside);
- hsym:=tsym(procdef.parast.Find('self'));
- if not(assigned(hsym) and
- (hsym.typ=paravarsym)) then
- internalerror(200305251);
- paraloc:=tparavarsym(hsym).paraloc[callerside].location;
- while paraloc<>nil do
- with paraloc^ do
- begin
- case loc of
- LOC_REGISTER:
- a_op_const_reg(list,OP_SUB,size,ioffset,register);
- LOC_REFERENCE:
- begin
- { offset in the wrapper needs to be adjusted for the stored
- return address }
- reference_reset_base(href,reference.index,reference.offset+sizeof(pint),sizeof(pint));
- a_op_const_ref(list,OP_SUB,size,ioffset,href);
- end
- else
- internalerror(200309189);
- end;
- paraloc:=next;
- end;
- end;
- procedure tcg.g_external_wrapper(list : TAsmList; procdef: tprocdef; const externalname: string);
- begin
- a_jmp_name(list,externalname);
- end;
- procedure tcg.a_call_name_static(list : TAsmList;const s : string);
- begin
- a_call_name(list,s,false);
- end;
- function tcg.g_indirect_sym_load(list:TAsmList;const symname: string; const flags: tindsymflags): tregister;
- var
- l: tasmsymbol;
- ref: treference;
- nlsymname: string;
- begin
- result := NR_NO;
- case target_info.system of
- system_powerpc_darwin,
- system_i386_darwin,
- system_i386_iphonesim,
- system_powerpc64_darwin,
- system_arm_darwin:
- begin
- nlsymname:='L'+symname+'$non_lazy_ptr';
- l:=current_asmdata.getasmsymbol(nlsymname);
- if not(assigned(l)) then
- begin
- new_section(current_asmdata.asmlists[al_picdata],sec_data_nonlazy,'',sizeof(pint));
- l:=current_asmdata.DefineAsmSymbol(nlsymname,AB_LOCAL,AT_DATA);
- current_asmdata.asmlists[al_picdata].concat(tai_symbol.create(l,0));
- if not(is_weak in flags) then
- current_asmdata.asmlists[al_picdata].concat(tai_directive.Create(asd_indirect_symbol,current_asmdata.RefAsmSymbol(symname).Name))
- else
- current_asmdata.asmlists[al_picdata].concat(tai_directive.Create(asd_indirect_symbol,current_asmdata.WeakRefAsmSymbol(symname).Name));
- {$ifdef cpu64bitaddr}
- current_asmdata.asmlists[al_picdata].concat(tai_const.create_64bit(0));
- {$else cpu64bitaddr}
- current_asmdata.asmlists[al_picdata].concat(tai_const.create_32bit(0));
- {$endif cpu64bitaddr}
- end;
- result := getaddressregister(list);
- reference_reset_symbol(ref,l,0,sizeof(pint));
- { a_load_ref_reg will turn this into a pic-load if needed }
- a_load_ref_reg(list,OS_ADDR,OS_ADDR,ref,result);
- end;
- end;
- end;
- procedure tcg.g_maybe_got_init(list: TAsmList);
- begin
- end;
- procedure tcg.g_call(list: TAsmList;const s: string);
- begin
- allocallcpuregisters(list);
- a_call_name(list,s,false);
- deallocallcpuregisters(list);
- end;
- procedure tcg.g_local_unwind(list: TAsmList; l: TAsmLabel);
- begin
- a_jmp_always(list,l);
- end;
- procedure tcg.a_loadmm_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister; shuffle: pmmshuffle);
- begin
- internalerror(200807231);
- end;
- procedure tcg.a_loadmm_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister; shuffle: pmmshuffle);
- begin
- internalerror(200807232);
- end;
- procedure tcg.a_loadmm_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference; shuffle: pmmshuffle);
- begin
- internalerror(200807233);
- end;
- procedure tcg.a_opmm_reg_reg(list: TAsmList; Op: TOpCG; size: tcgsize; src, dst: tregister; shuffle: pmmshuffle);
- begin
- internalerror(200807234);
- end;
- function tcg.getflagregister(list: TAsmList; size: Tcgsize): Tregister;
- begin
- Result:=TRegister(0);
- internalerror(200807238);
- end;
- procedure tcg.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: tcgsize; src, dst: TRegister);
- begin
- internalerror(2014070601);
- end;
- procedure tcg.g_stackpointer_alloc(list: TAsmList; size: longint);
- begin
- internalerror(2014070602);
- end;
- procedure tcg.a_mul_reg_reg_pair(list: TAsmList; size: TCgSize; src1,src2,dstlo,dsthi: TRegister);
- begin
- internalerror(2014060801);
- end;
- procedure tcg.g_div_const_reg_reg(list:tasmlist; size: TCgSize; a: tcgint; src,dst: tregister);
- var
- divreg: tregister;
- magic: aInt;
- u_magic: aWord;
- u_shift: byte;
- u_add: boolean;
- begin
- divreg:=getintregister(list,OS_INT);
- if (size in [OS_S32,OS_S64]) then
- begin
- calc_divconst_magic_signed(tcgsize2size[size]*8,a,magic,u_shift);
- { load magic value }
- a_load_const_reg(list,OS_INT,magic,divreg);
- { multiply, discarding low bits }
- a_mul_reg_reg_pair(list,size,src,divreg,NR_NO,dst);
- { add/subtract numerator }
- if (a>0) and (magic<0) then
- a_op_reg_reg_reg(list,OP_ADD,OS_INT,src,dst,dst)
- else if (a<0) and (magic>0) then
- a_op_reg_reg_reg(list,OP_SUB,OS_INT,src,dst,dst);
- { shift shift places to the right (arithmetic) }
- a_op_const_reg_reg(list,OP_SAR,OS_INT,u_shift,dst,dst);
- { extract and add sign bit }
- if (a>=0) then
- a_op_const_reg_reg(list,OP_SHR,OS_INT,tcgsize2size[size]*8-1,src,divreg)
- else
- a_op_const_reg_reg(list,OP_SHR,OS_INT,tcgsize2size[size]*8-1,dst,divreg);
- a_op_reg_reg_reg(list,OP_ADD,OS_INT,dst,divreg,dst);
- end
- else if (size in [OS_32,OS_64]) then
- begin
- calc_divconst_magic_unsigned(tcgsize2size[size]*8,a,u_magic,u_add,u_shift);
- { load magic in divreg }
- a_load_const_reg(list,OS_INT,tcgint(u_magic),divreg);
- { multiply, discarding low bits }
- a_mul_reg_reg_pair(list,size,src,divreg,NR_NO,dst);
- if (u_add) then
- begin
- { Calculate "(numerator+result) shr u_shift", avoiding possible overflow }
- a_op_reg_reg_reg(list,OP_SUB,OS_INT,dst,src,divreg);
- { divreg=(numerator-result) }
- a_op_const_reg_reg(list,OP_SHR,OS_INT,1,divreg,divreg);
- { divreg=(numerator-result)/2 }
- a_op_reg_reg_reg(list,OP_ADD,OS_INT,divreg,dst,divreg);
- { divreg=(numerator+result)/2, already shifted by 1, so decrease u_shift. }
- a_op_const_reg_reg(list,OP_SHR,OS_INT,u_shift-1,divreg,dst);
- end
- else
- a_op_const_reg_reg(list,OP_SHR,OS_INT,u_shift,dst,dst);
- end
- else
- InternalError(2014060601);
- end;
- {*****************************************************************************
- TCG64
- *****************************************************************************}
- {$ifndef cpu64bitalu}
- function joinreg64(reglo,reghi : tregister) : tregister64;
- begin
- result.reglo:=reglo;
- result.reghi:=reghi;
- end;
- procedure tcg64.a_op64_const_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;value : int64; regsrc,regdst : tregister64);
- begin
- a_load64_reg_reg(list,regsrc,regdst);
- a_op64_const_reg(list,op,size,value,regdst);
- end;
- procedure tcg64.a_op64_reg_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64);
- var
- tmpreg64 : tregister64;
- begin
- { when src1=dst then we need to first create a temp to prevent
- overwriting src1 with src2 }
- if (regsrc1.reghi=regdst.reghi) or
- (regsrc1.reglo=regdst.reghi) or
- (regsrc1.reghi=regdst.reglo) or
- (regsrc1.reglo=regdst.reglo) then
- begin
- tmpreg64.reglo:=cg.getintregister(list,OS_32);
- tmpreg64.reghi:=cg.getintregister(list,OS_32);
- a_load64_reg_reg(list,regsrc2,tmpreg64);
- a_op64_reg_reg(list,op,size,regsrc1,tmpreg64);
- a_load64_reg_reg(list,tmpreg64,regdst);
- end
- else
- begin
- a_load64_reg_reg(list,regsrc2,regdst);
- a_op64_reg_reg(list,op,size,regsrc1,regdst);
- end;
- end;
- procedure tcg64.a_op64_const_subsetref(list : TAsmList; Op : TOpCG; size : TCGSize; a : int64; const sref: tsubsetreference);
- var
- tmpreg64 : tregister64;
- begin
- tmpreg64.reglo:=cg.getintregister(list,OS_32);
- tmpreg64.reghi:=cg.getintregister(list,OS_32);
- a_load64_subsetref_reg(list,sref,tmpreg64);
- a_op64_const_reg(list,op,size,a,tmpreg64);
- a_load64_reg_subsetref(list,tmpreg64,sref);
- end;
- procedure tcg64.a_op64_reg_subsetref(list : TAsmList; Op : TOpCG; size : TCGSize; reg: tregister64; const sref: tsubsetreference);
- var
- tmpreg64 : tregister64;
- begin
- tmpreg64.reglo:=cg.getintregister(list,OS_32);
- tmpreg64.reghi:=cg.getintregister(list,OS_32);
- a_load64_subsetref_reg(list,sref,tmpreg64);
- a_op64_reg_reg(list,op,size,reg,tmpreg64);
- a_load64_reg_subsetref(list,tmpreg64,sref);
- end;
- procedure tcg64.a_op64_ref_subsetref(list : TAsmList; Op : TOpCG; size : TCGSize; const ref: treference; const sref: tsubsetreference);
- var
- tmpreg64 : tregister64;
- begin
- tmpreg64.reglo:=cg.getintregister(list,OS_32);
- tmpreg64.reghi:=cg.getintregister(list,OS_32);
- a_load64_subsetref_reg(list,sref,tmpreg64);
- a_op64_ref_reg(list,op,size,ref,tmpreg64);
- a_load64_reg_subsetref(list,tmpreg64,sref);
- end;
- procedure tcg64.a_op64_subsetref_subsetref(list : TAsmList; Op : TOpCG; size : TCGSize; const ssref,dsref: tsubsetreference);
- var
- tmpreg64 : tregister64;
- begin
- tmpreg64.reglo:=cg.getintregister(list,OS_32);
- tmpreg64.reghi:=cg.getintregister(list,OS_32);
- a_load64_subsetref_reg(list,ssref,tmpreg64);
- a_op64_reg_subsetref(list,op,size,tmpreg64,dsref);
- end;
- procedure tcg64.a_op64_const_reg_reg_checkoverflow(list: TAsmList;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64;setflags : boolean;var ovloc : tlocation);
- begin
- a_op64_const_reg_reg(list,op,size,value,regsrc,regdst);
- ovloc.loc:=LOC_VOID;
- end;
- procedure tcg64.a_op64_reg_reg_reg_checkoverflow(list: TAsmList;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64;setflags : boolean;var ovloc : tlocation);
- begin
- a_op64_reg_reg_reg(list,op,size,regsrc1,regsrc2,regdst);
- ovloc.loc:=LOC_VOID;
- end;
- procedure tcg64.a_load64_loc_subsetref(list : TAsmList;const l: tlocation; const sref : tsubsetreference);
- begin
- case l.loc of
- LOC_REFERENCE, LOC_CREFERENCE:
- a_load64_ref_subsetref(list,l.reference,sref);
- LOC_REGISTER,LOC_CREGISTER:
- a_load64_reg_subsetref(list,l.register64,sref);
- LOC_CONSTANT :
- a_load64_const_subsetref(list,l.value64,sref);
- LOC_SUBSETREF,LOC_CSUBSETREF:
- a_load64_subsetref_subsetref(list,l.sref,sref);
- else
- internalerror(2006082210);
- end;
- end;
- procedure tcg64.a_load64_subsetref_loc(list: TAsmlist; const sref: tsubsetreference; const l: tlocation);
- begin
- case l.loc of
- LOC_REFERENCE, LOC_CREFERENCE:
- a_load64_subsetref_ref(list,sref,l.reference);
- LOC_REGISTER,LOC_CREGISTER:
- a_load64_subsetref_reg(list,sref,l.register64);
- LOC_SUBSETREF,LOC_CSUBSETREF:
- a_load64_subsetref_subsetref(list,sref,l.sref);
- else
- internalerror(2006082211);
- end;
- end;
- {$else cpu64bitalu}
- function joinreg128(reglo, reghi: tregister): tregister128;
- begin
- result.reglo:=reglo;
- result.reghi:=reghi;
- end;
- procedure splitparaloc128(const cgpara:tcgpara;var cgparalo,cgparahi:tcgpara);
- var
- paraloclo,
- paralochi : pcgparalocation;
- begin
- if not(cgpara.size in [OS_128,OS_S128]) then
- internalerror(2012090604);
- if not assigned(cgpara.location) then
- internalerror(2012090605);
- { init lo/hi para }
- cgparahi.reset;
- if cgpara.size=OS_S128 then
- cgparahi.size:=OS_S64
- else
- cgparahi.size:=OS_64;
- cgparahi.intsize:=8;
- cgparahi.alignment:=cgpara.alignment;
- paralochi:=cgparahi.add_location;
- cgparalo.reset;
- cgparalo.size:=OS_64;
- cgparalo.intsize:=8;
- cgparalo.alignment:=cgpara.alignment;
- paraloclo:=cgparalo.add_location;
- { 2 parameter fields? }
- if assigned(cgpara.location^.next) then
- begin
- { Order for multiple locations is always
- paraloc^ -> high
- paraloc^.next -> low }
- if (target_info.endian=ENDIAN_BIG) then
- begin
- { paraloc^ -> high
- paraloc^.next -> low }
- move(cgpara.location^,paralochi^,sizeof(paralochi^));
- move(cgpara.location^.next^,paraloclo^,sizeof(paraloclo^));
- end
- else
- begin
- { paraloc^ -> low
- paraloc^.next -> high }
- move(cgpara.location^,paraloclo^,sizeof(paraloclo^));
- move(cgpara.location^.next^,paralochi^,sizeof(paralochi^));
- end;
- end
- else
- begin
- { single parameter, this can only be in memory }
- if cgpara.location^.loc<>LOC_REFERENCE then
- internalerror(2012090606);
- move(cgpara.location^,paraloclo^,sizeof(paraloclo^));
- move(cgpara.location^,paralochi^,sizeof(paralochi^));
- { for big endian low is at +8, for little endian high }
- if target_info.endian = endian_big then
- begin
- inc(cgparalo.location^.reference.offset,8);
- cgparalo.alignment:=newalignment(cgparalo.alignment,8);
- end
- else
- begin
- inc(cgparahi.location^.reference.offset,8);
- cgparahi.alignment:=newalignment(cgparahi.alignment,8);
- end;
- end;
- { fix size }
- paraloclo^.size:=cgparalo.size;
- paraloclo^.next:=nil;
- paralochi^.size:=cgparahi.size;
- paralochi^.next:=nil;
- end;
- procedure tcg128.a_load128_reg_reg(list: TAsmList; regsrc,
- regdst: tregister128);
- begin
- cg.a_load_reg_reg(list,OS_64,OS_64,regsrc.reglo,regdst.reglo);
- cg.a_load_reg_reg(list,OS_64,OS_64,regsrc.reghi,regdst.reghi);
- end;
- procedure tcg128.a_load128_reg_ref(list: TAsmList; reg: tregister128;
- const ref: treference);
- var
- tmpreg: tregister;
- tmpref: treference;
- begin
- if target_info.endian = endian_big then
- begin
- tmpreg:=reg.reglo;
- reg.reglo:=reg.reghi;
- reg.reghi:=tmpreg;
- end;
- cg.a_load_reg_ref(list,OS_64,OS_64,reg.reglo,ref);
- tmpref := ref;
- inc(tmpref.offset,8);
- cg.a_load_reg_ref(list,OS_64,OS_64,reg.reghi,tmpref);
- end;
- procedure tcg128.a_load128_ref_reg(list: TAsmList; const ref: treference;
- reg: tregister128);
- var
- tmpreg: tregister;
- tmpref: treference;
- begin
- if target_info.endian = endian_big then
- begin
- tmpreg := reg.reglo;
- reg.reglo := reg.reghi;
- reg.reghi := tmpreg;
- end;
- tmpref := ref;
- if (tmpref.base=reg.reglo) then
- begin
- tmpreg:=cg.getaddressregister(list);
- cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,tmpref.base,tmpreg);
- tmpref.base:=tmpreg;
- end
- else
- { this works only for the i386, thus the i386 needs to override }
- { this method and this method must be replaced by a more generic }
- { implementation FK }
- if (tmpref.index=reg.reglo) then
- begin
- tmpreg:=cg.getaddressregister(list);
- cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,tmpref.index,tmpreg);
- tmpref.index:=tmpreg;
- end;
- cg.a_load_ref_reg(list,OS_64,OS_64,tmpref,reg.reglo);
- inc(tmpref.offset,8);
- cg.a_load_ref_reg(list,OS_64,OS_64,tmpref,reg.reghi);
- end;
- procedure tcg128.a_load128_loc_ref(list: TAsmList; const l: tlocation;
- const ref: treference);
- begin
- case l.loc of
- LOC_REGISTER,LOC_CREGISTER:
- a_load128_reg_ref(list,l.register128,ref);
- { not yet implemented:
- LOC_CONSTANT :
- a_load128_const_ref(list,l.value128,ref);
- LOC_SUBSETREF, LOC_CSUBSETREF:
- a_load64_subsetref_ref(list,l.sref,ref); }
- else
- internalerror(201209061);
- end;
- end;
- procedure tcg128.a_load128_reg_loc(list: TAsmList; reg: tregister128;
- const l: tlocation);
- begin
- case l.loc of
- LOC_REFERENCE, LOC_CREFERENCE:
- a_load128_reg_ref(list,reg,l.reference);
- LOC_REGISTER,LOC_CREGISTER:
- a_load128_reg_reg(list,reg,l.register128);
- { not yet implemented:
- LOC_SUBSETREF, LOC_CSUBSETREF:
- a_load64_reg_subsetref(list,reg,l.sref);
- LOC_MMREGISTER, LOC_CMMREGISTER:
- a_loadmm_intreg64_reg(list,l.size,reg,l.register); }
- else
- internalerror(201209062);
- end;
- end;
- procedure tcg128.a_load128_const_reg(list: TAsmList; valuelo,
- valuehi: int64; reg: tregister128);
- begin
- cg.a_load_const_reg(list,OS_64,aint(valuelo),reg.reglo);
- cg.a_load_const_reg(list,OS_64,aint(valuehi),reg.reghi);
- end;
- procedure tcg128.a_load128_loc_cgpara(list: TAsmList; const l: tlocation;
- const paraloc: TCGPara);
- begin
- case l.loc of
- LOC_REGISTER,
- LOC_CREGISTER :
- a_load128_reg_cgpara(list,l.register128,paraloc);
- {not yet implemented:
- LOC_CONSTANT :
- a_load128_const_cgpara(list,l.value64,paraloc);
- }
- LOC_CREFERENCE,
- LOC_REFERENCE :
- a_load128_ref_cgpara(list,l.reference,paraloc);
- else
- internalerror(2012090603);
- end;
- end;
- procedure tcg128.a_load128_reg_cgpara(list : TAsmList;reg : tregister128;const paraloc : tcgpara);
- var
- tmplochi,tmploclo: tcgpara;
- begin
- tmploclo.init;
- tmplochi.init;
- splitparaloc128(paraloc,tmploclo,tmplochi);
- cg.a_load_reg_cgpara(list,OS_64,reg.reghi,tmplochi);
- cg.a_load_reg_cgpara(list,OS_64,reg.reglo,tmploclo);
- tmploclo.done;
- tmplochi.done;
- end;
- procedure tcg128.a_load128_ref_cgpara(list : TAsmList;const r : treference;const paraloc : tcgpara);
- var
- tmprefhi,tmpreflo : treference;
- tmploclo,tmplochi : tcgpara;
- begin
- tmploclo.init;
- tmplochi.init;
- splitparaloc128(paraloc,tmploclo,tmplochi);
- tmprefhi:=r;
- tmpreflo:=r;
- if target_info.endian=endian_big then
- inc(tmpreflo.offset,8)
- else
- inc(tmprefhi.offset,8);
- cg.a_load_ref_cgpara(list,OS_64,tmprefhi,tmplochi);
- cg.a_load_ref_cgpara(list,OS_64,tmpreflo,tmploclo);
- tmploclo.done;
- tmplochi.done;
- end;
- {$endif cpu64bitalu}
- function asmsym2indsymflags(sym: TAsmSymbol): tindsymflags;
- begin
- result:=[];
- if sym.typ<>AT_FUNCTION then
- include(result,is_data);
- if sym.bind=AB_WEAK_EXTERNAL then
- include(result,is_weak);
- end;
- procedure destroy_codegen;
- begin
- cg.free;
- cg:=nil;
- {$ifdef cpu64bitalu}
- cg128.free;
- cg128:=nil;
- {$else cpu64bitalu}
- cg64.free;
- cg64:=nil;
- {$endif cpu64bitalu}
- end;
- end.
|