12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195 |
- {
- 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
- cclasses,globtype,
- cpubase,cgbase,cgutils,parabase,
- aasmbase,aasmtai,aasmdata,aasmcpu,
- symconst,symbase,symtype,symdef,symtable,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 overriden for all new processors which will be supported
- by Free Pascal. For 32-bit processors, the base class
- sould be @link(tcg64f32) and not @var(tcg).
- }
- tcg = class
- public
- alignment : talignment;
- rg : array[tregistertype] of trgobj;
- t_times : longint;
- {$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_extend_backwards(b: boolean);
- {$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;abstract;
- {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.
- This must be overriden for each CPU target.
- @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_param_reg(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 overriden for optimization purposes if the cpu
- permits directly sending this type of parameter.
- @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_param_const(list : TAsmList;size : tcgsize;a : aint;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 overriden for optimization purposes if the cpu
- permits directly sending this type of parameter.
- @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_param_ref(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_param_loc(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.
- A generic version is provided. This routine should
- be overriden 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_paramaddr_ref(list : TAsmList;const r : treference;const cgpara : TCGPara);virtual;
- { 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 overriden for each new target cpu.
- There is no a_call_ref because loading the reference will use
- a temp register on most cpu's resulting in conflicts with the
- registers used for the parameters (PFV)
- }
- procedure a_call_name(list : TAsmList;const s : string);virtual; abstract;
- procedure a_call_reg(list : TAsmList;reg : tregister);virtual; abstract;
- procedure a_call_ref(list : TAsmList;ref : treference);virtual; abstract;
- { same as a_call_name, might be overriden 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 : aint;register : tregister);virtual; abstract;
- procedure a_load_const_ref(list : TAsmList;size : tcgsize;a : aint;const ref : treference);virtual;
- procedure a_load_const_loc(list : TAsmList;a : aint;const loc : tlocation);
- procedure a_load_reg_ref(list : TAsmList;fromsize,tosize : tcgsize;register : tregister;const ref : treference);virtual; abstract;
- 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_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;
- { fpu move instructions }
- procedure a_loadfpu_reg_reg(list: TAsmList; size:tcgsize; reg1, reg2: tregister); virtual; abstract;
- procedure a_loadfpu_ref_reg(list: TAsmList; size: tcgsize; const ref: treference; reg: tregister); virtual; abstract;
- procedure a_loadfpu_reg_ref(list: TAsmList; size: tcgsize; reg: tregister; const ref: treference); virtual; abstract;
- procedure a_loadfpu_loc_reg(list: TAsmList; const loc: tlocation; const reg: tregister);
- procedure a_loadfpu_reg_loc(list: TAsmList; size: tcgsize; const reg: tregister; const loc: tlocation);
- procedure a_paramfpu_reg(list : TAsmList;size : tcgsize;const r : tregister;const cgpara : TCGPara);virtual;
- procedure a_paramfpu_ref(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; abstract;
- procedure a_loadmm_ref_reg(list: TAsmList; fromsize, tosize : tcgsize;const ref: treference; reg: tregister;shuffle : pmmshuffle); virtual; abstract;
- procedure a_loadmm_reg_ref(list: TAsmList; fromsize, tosize : tcgsize;reg: tregister; const ref: treference;shuffle : pmmshuffle); virtual; abstract;
- 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_parammm_reg(list: TAsmList; size: tcgsize; reg: tregister;const cgpara : TCGPara;shuffle : pmmshuffle); virtual;
- procedure a_parammm_ref(list: TAsmList; size: tcgsize; const ref: treference;const cgpara : TCGPara;shuffle : pmmshuffle); virtual;
- procedure a_parammm_loc(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;abstract;
- 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;
- { 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: Aint; reg: TRegister); virtual; abstract;
- procedure a_op_const_ref(list : TAsmList; Op: TOpCG; size: TCGSize; a: Aint; const ref: TReference); virtual;
- procedure a_op_const_loc(list : TAsmList; Op: TOpCG; a: Aint; 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: aint; 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: aint; 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 : aint;reg : tregister;
- l : tasmlabel);virtual; abstract;
- procedure a_cmp_const_ref_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : aint;const ref : treference;
- l : tasmlabel); virtual;
- procedure a_cmp_const_loc_label(list: TAsmList; size: tcgsize;cmp_op: topcmp; a: aint; 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;
- 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;
- {
- 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(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(var op: topcg; var a : aint);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: aint);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_testself(list : TAsmList;reg:tregister);
- 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 overriden 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 : aint);virtual; abstract;
- {# This should emit the opcode to copy len bytes from the an unaligned source
- to destination.
- It must be overriden 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 : aint);virtual;
- {# This should emit the opcode to a shortrstring from the source
- to destination.
- @param(source Source reference of copy)
- @param(dest Destination reference of copy)
- }
- procedure g_copyshortstring(list : TAsmList;const source,dest : treference;len:byte);
- procedure g_incrrefcount(list : TAsmList;t: tdef; const ref: treference);
- procedure g_decrrefcount(list : TAsmList;t: tdef; const ref: treference);
- procedure g_initialize(list : TAsmList;t : tdef;const ref : treference);
- procedure g_finalize(list : TAsmList;t : tdef;const ref : treference);
- {# Generates range checking code. It is to note
- that this routine does not need to be overriden,
- as it takes care of everything.
- @param(p Node which contains the value to check)
- @param(todef Type definition of node to range check)
- }
- procedure g_rangecheck(list: TAsmList; const l:tlocation; fromdef,todef: tdef); 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;
- procedure g_copyvaluepara_openarray(list : TAsmList;const ref:treference;const lenloc:tlocation;elesize:aint;destreg:tregister);virtual;
- procedure g_releasevaluepara_openarray(list : TAsmList;const l: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 overriden 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; abstract;
- {# 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_standard_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_standard_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: aint);virtual;
- function g_indirect_sym_load(list:TAsmList;const symname: string): tregister;virtual;
- end;
- {$ifndef cpu64bit}
- {# @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_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_param64_reg(list : TAsmList;reg64 : tregister64;const loc : TCGPara);virtual;abstract;
- procedure a_param64_const(list : TAsmList;value : int64;const loc : TCGPara);virtual;abstract;
- procedure a_param64_ref(list : TAsmList;const r : treference;const loc : TCGPara);virtual;abstract;
- procedure a_param64_loc(list : TAsmList;const l : tlocation;const loc : TCGPara);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;
- {$endif cpu64bit}
- var
- {# Main code generator class }
- cg : tcg;
- {$ifndef cpu64bit}
- {# Code generator class for all operations working with 64-Bit operands }
- cg64 : tcg64;
- {$endif cpu64bit}
- implementation
- uses
- globals,options,systems,
- verbose,defutil,paramgr,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;
- 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(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(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(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(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));
- {$ifndef i386}
- alloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
- {$ifdef cpumm}
- alloccpuregisters(list,R_MMREGISTER,paramanager.get_volatile_registers_mm(pocall_default));
- {$endif cpumm}
- {$endif i386}
- 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));
- {$ifndef i386}
- dealloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
- {$ifdef cpumm}
- dealloccpuregisters(list,R_MMREGISTER,paramanager.get_volatile_registers_mm(pocall_default));
- {$endif cpumm}
- {$endif i386}
- 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);
- 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_extend_backwards(b: boolean);
- var
- rt : tregistertype;
- begin
- for rt:=low(rg) to high(rg) do
- begin
- if assigned(rg[rt]) then
- rg[rt].extend_live_range_backwards := b;;
- 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_param_reg(list : TAsmList;size : tcgsize;r : tregister;const cgpara : TCGPara);
- var
- ref : treference;
- begin
- cgpara.check_simple_location;
- 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);
- a_load_reg_ref(list,size,cgpara.location^.size,r,ref);
- end
- else
- internalerror(2002071004);
- end;
- end;
- procedure tcg.a_param_const(list : TAsmList;size : tcgsize;a : aint;const cgpara : TCGPara);
- var
- ref : treference;
- begin
- cgpara.check_simple_location;
- 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);
- a_load_const_ref(list,cgpara.location^.size,a,ref);
- end
- else
- internalerror(2002071004);
- end;
- end;
- procedure tcg.a_param_ref(list : TAsmList;size : tcgsize;const r : treference;const cgpara : TCGPara);
- var
- ref : treference;
- begin
- cgpara.check_simple_location;
- case cgpara.location^.loc of
- LOC_REGISTER,LOC_CREGISTER:
- a_load_ref_reg(list,size,cgpara.location^.size,r,cgpara.location^.register);
- LOC_REFERENCE,LOC_CREFERENCE:
- begin
- reference_reset(ref);
- ref.base:=cgpara.location^.reference.index;
- ref.offset:=cgpara.location^.reference.offset;
- { use concatcopy, because it can also be a float which fails when
- load_ref_ref is used }
- g_concatcopy(list,r,ref,cgpara.intsize);
- end
- else
- internalerror(2002071004);
- end;
- end;
- procedure tcg.a_param_loc(list : TAsmList;const l:tlocation;const cgpara : TCGPara);
- begin
- case l.loc of
- LOC_REGISTER,
- LOC_CREGISTER :
- a_param_reg(list,l.size,l.register,cgpara);
- LOC_CONSTANT :
- a_param_const(list,l.size,l.value,cgpara);
- LOC_CREFERENCE,
- LOC_REFERENCE :
- a_param_ref(list,l.size,l.reference,cgpara);
- else
- internalerror(2002032211);
- end;
- end;
- procedure tcg.a_paramaddr_ref(list : TAsmList;const r : treference;const cgpara : TCGPara);
- var
- hr : tregister;
- begin
- cgpara.check_simple_location;
- hr:=getaddressregister(list);
- a_loadaddr_ref_reg(list,r,hr);
- a_param_reg(list,OS_ADDR,hr,cgpara);
- end;
- {****************************************************************************
- some generic implementations
- ****************************************************************************}
- 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 : aint;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 : aint;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);
- 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(var op: topcg; var a : aint);
- var
- powerval : longint;
- begin
- 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 a = -1 then
- op:=OP_MOVE;
- end;
- OP_AND :
- begin
- { and with max returns same result }
- if (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(a), powerval) 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(a), powerval) 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:
- begin
- if a = 0 then
- op:=OP_NONE;
- end;
- end;
- end;
- procedure tcg.a_loadfpu_loc_reg(list: TAsmList; const loc: tlocation; const reg: tregister);
- begin
- case loc.loc of
- LOC_REFERENCE, LOC_CREFERENCE:
- a_loadfpu_ref_reg(list,loc.size,loc.reference,reg);
- LOC_FPUREGISTER, LOC_CFPUREGISTER:
- a_loadfpu_reg_reg(list,loc.size,loc.register,reg);
- else
- internalerror(200203301);
- end;
- end;
- procedure tcg.a_loadfpu_reg_loc(list: TAsmList; size: tcgsize; const reg: tregister; const loc: tlocation);
- begin
- case loc.loc of
- LOC_REFERENCE, LOC_CREFERENCE:
- a_loadfpu_reg_ref(list,size,reg,loc.reference);
- LOC_FPUREGISTER, LOC_CFPUREGISTER:
- a_loadfpu_reg_reg(list,size,reg,loc.register);
- else
- internalerror(48991);
- end;
- end;
- procedure tcg.a_paramfpu_reg(list : TAsmList;size : tcgsize;const r : tregister;const cgpara : TCGPara);
- var
- ref : treference;
- begin
- case cgpara.location^.loc of
- LOC_FPUREGISTER,LOC_CFPUREGISTER:
- begin
- cgpara.check_simple_location;
- a_loadfpu_reg_reg(list,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);
- a_loadfpu_reg_ref(list,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],tt_normal,ref);
- a_loadfpu_reg_ref(list,size,r,ref);
- a_paramfpu_ref(list,size,ref,cgpara);
- tg.Ungettemp(list,ref);
- end;
- else
- internalerror(2002071004);
- end;
- end;
- procedure tcg.a_paramfpu_ref(list : TAsmList;size : tcgsize;const ref : treference;const cgpara : TCGPara);
- var
- href : treference;
- begin
- cgpara.check_simple_location;
- case cgpara.location^.loc of
- LOC_FPUREGISTER,LOC_CFPUREGISTER:
- a_loadfpu_ref_reg(list,size,ref,cgpara.location^.register);
- LOC_REFERENCE,LOC_CREFERENCE:
- begin
- reference_reset_base(href,cgpara.location^.reference.index,cgpara.location^.reference.offset);
- { concatcopy should choose the best way to copy the data }
- g_concatcopy(list,ref,href,tcgsize2size[size]);
- end;
- else
- internalerror(200402201);
- end;
- end;
- procedure tcg.a_op_const_ref(list : TAsmList; Op: TOpCG; size: TCGSize; a: aint; 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: aint; 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:aint;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
- 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;
- procedure tcg.a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; a: aint; 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_ref_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : aint;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 : aint;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);
- 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_parammm_reg(list: TAsmList; size: tcgsize; reg: tregister;const cgpara : TCGPara;shuffle : pmmshuffle);
- var
- href : treference;
- begin
- cgpara.check_simple_location;
- 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);
- a_loadmm_reg_ref(list,size,cgpara.location^.size,reg,href,shuffle);
- end
- else
- internalerror(200310123);
- end;
- end;
- procedure tcg.a_parammm_ref(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_parammm_reg(list,cgpara.location^.size,hr,cgpara,@hs);
- end
- else
- a_parammm_reg(list,cgpara.location^.size,hr,cgpara,shuffle);
- end;
- procedure tcg.a_parammm_loc(list: TAsmList;const loc: tlocation; const cgpara : TCGPara;shuffle : pmmshuffle);
- begin
- case loc.loc of
- LOC_MMREGISTER,LOC_CMMREGISTER:
- a_parammm_reg(list,loc.size,loc.register,cgpara,shuffle);
- LOC_REFERENCE,LOC_CREFERENCE:
- a_parammm_ref(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_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.g_concatcopy_unaligned(list : TAsmList;const source,dest : treference;len : aint);
- begin
- g_concatcopy(list,source,dest,len);
- end;
- procedure tcg.g_copyshortstring(list : TAsmList;const source,dest : treference;len:byte);
- var
- cgpara1,cgpara2,cgpara3 : TCGPara;
- begin
- cgpara1.init;
- cgpara2.init;
- cgpara3.init;
- paramanager.getintparaloc(pocall_default,1,cgpara1);
- paramanager.getintparaloc(pocall_default,2,cgpara2);
- paramanager.getintparaloc(pocall_default,3,cgpara3);
- paramanager.allocparaloc(list,cgpara3);
- a_paramaddr_ref(list,dest,cgpara3);
- paramanager.allocparaloc(list,cgpara2);
- a_paramaddr_ref(list,source,cgpara2);
- paramanager.allocparaloc(list,cgpara1);
- a_param_const(list,OS_INT,len,cgpara1);
- paramanager.freeparaloc(list,cgpara3);
- paramanager.freeparaloc(list,cgpara2);
- paramanager.freeparaloc(list,cgpara1);
- allocallcpuregisters(list);
- a_call_name(list,'FPC_SHORTSTR_ASSIGN');
- deallocallcpuregisters(list);
- cgpara3.done;
- cgpara2.done;
- cgpara1.done;
- end;
- procedure tcg.g_incrrefcount(list : TAsmList;t: tdef; const ref: treference);
- var
- href : treference;
- incrfunc : string;
- cgpara1,cgpara2 : TCGPara;
- begin
- cgpara1.init;
- cgpara2.init;
- paramanager.getintparaloc(pocall_default,1,cgpara1);
- paramanager.getintparaloc(pocall_default,2,cgpara2);
- if is_interfacecom(t) then
- incrfunc:='FPC_INTF_INCR_REF'
- else if is_ansistring(t) then
- incrfunc:='FPC_ANSISTR_INCR_REF'
- else if is_widestring(t) then
- incrfunc:='FPC_WIDESTR_INCR_REF'
- else if is_dynamic_array(t) then
- incrfunc:='FPC_DYNARRAY_INCR_REF'
- else
- incrfunc:='';
- { call the special incr function or the generic addref }
- if incrfunc<>'' then
- begin
- paramanager.allocparaloc(list,cgpara1);
- { these functions get the pointer by value }
- a_param_ref(list,OS_ADDR,ref,cgpara1);
- paramanager.freeparaloc(list,cgpara1);
- allocallcpuregisters(list);
- a_call_name(list,incrfunc);
- deallocallcpuregisters(list);
- end
- else
- begin
- reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
- paramanager.allocparaloc(list,cgpara2);
- a_paramaddr_ref(list,href,cgpara2);
- paramanager.allocparaloc(list,cgpara1);
- a_paramaddr_ref(list,ref,cgpara1);
- paramanager.freeparaloc(list,cgpara1);
- paramanager.freeparaloc(list,cgpara2);
- allocallcpuregisters(list);
- a_call_name(list,'FPC_ADDREF');
- deallocallcpuregisters(list);
- end;
- cgpara2.done;
- cgpara1.done;
- end;
- procedure tcg.g_decrrefcount(list : TAsmList;t: tdef; const ref: treference);
- var
- href : treference;
- decrfunc : string;
- needrtti : boolean;
- cgpara1,cgpara2 : TCGPara;
- tempreg1,tempreg2 : TRegister;
- begin
- cgpara1.init;
- cgpara2.init;
- paramanager.getintparaloc(pocall_default,1,cgpara1);
- paramanager.getintparaloc(pocall_default,2,cgpara2);
- needrtti:=false;
- if is_interfacecom(t) then
- decrfunc:='FPC_INTF_DECR_REF'
- else if is_ansistring(t) then
- decrfunc:='FPC_ANSISTR_DECR_REF'
- else if is_widestring(t) then
- decrfunc:='FPC_WIDESTR_DECR_REF'
- else if is_dynamic_array(t) then
- begin
- decrfunc:='FPC_DYNARRAY_DECR_REF';
- needrtti:=true;
- end
- else
- decrfunc:='';
- { call the special decr function or the generic decref }
- if decrfunc<>'' then
- begin
- if needrtti then
- begin
- reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
- tempreg2:=getaddressregister(list);
- a_loadaddr_ref_reg(list,href,tempreg2);
- end;
- tempreg1:=getaddressregister(list);
- a_loadaddr_ref_reg(list,ref,tempreg1);
- if needrtti then
- begin
- paramanager.allocparaloc(list,cgpara2);
- a_param_reg(list,OS_ADDR,tempreg2,cgpara2);
- paramanager.freeparaloc(list,cgpara2);
- end;
- paramanager.allocparaloc(list,cgpara1);
- a_param_reg(list,OS_ADDR,tempreg1,cgpara1);
- paramanager.freeparaloc(list,cgpara1);
- allocallcpuregisters(list);
- a_call_name(list,decrfunc);
- deallocallcpuregisters(list);
- end
- else
- begin
- reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
- paramanager.allocparaloc(list,cgpara2);
- a_paramaddr_ref(list,href,cgpara2);
- paramanager.allocparaloc(list,cgpara1);
- a_paramaddr_ref(list,ref,cgpara1);
- paramanager.freeparaloc(list,cgpara1);
- paramanager.freeparaloc(list,cgpara2);
- allocallcpuregisters(list);
- a_call_name(list,'FPC_DECREF');
- deallocallcpuregisters(list);
- end;
- cgpara2.done;
- cgpara1.done;
- end;
- procedure tcg.g_initialize(list : TAsmList;t : tdef;const ref : treference);
- var
- href : treference;
- cgpara1,cgpara2 : TCGPara;
- begin
- cgpara1.init;
- cgpara2.init;
- paramanager.getintparaloc(pocall_default,1,cgpara1);
- paramanager.getintparaloc(pocall_default,2,cgpara2);
- if is_ansistring(t) or
- is_widestring(t) or
- is_interfacecom(t) or
- is_dynamic_array(t) then
- a_load_const_ref(list,OS_ADDR,0,ref)
- else
- begin
- reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
- paramanager.allocparaloc(list,cgpara2);
- a_paramaddr_ref(list,href,cgpara2);
- paramanager.allocparaloc(list,cgpara1);
- a_paramaddr_ref(list,ref,cgpara1);
- paramanager.freeparaloc(list,cgpara1);
- paramanager.freeparaloc(list,cgpara2);
- allocallcpuregisters(list);
- a_call_name(list,'FPC_INITIALIZE');
- deallocallcpuregisters(list);
- end;
- cgpara1.done;
- cgpara2.done;
- end;
- procedure tcg.g_finalize(list : TAsmList;t : tdef;const ref : treference);
- var
- href : treference;
- cgpara1,cgpara2 : TCGPara;
- begin
- cgpara1.init;
- cgpara2.init;
- paramanager.getintparaloc(pocall_default,1,cgpara1);
- paramanager.getintparaloc(pocall_default,2,cgpara2);
- if is_ansistring(t) or
- is_widestring(t) or
- is_interfacecom(t) then
- begin
- g_decrrefcount(list,t,ref);
- a_load_const_ref(list,OS_ADDR,0,ref);
- end
- else
- begin
- reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
- paramanager.allocparaloc(list,cgpara2);
- a_paramaddr_ref(list,href,cgpara2);
- paramanager.allocparaloc(list,cgpara1);
- a_paramaddr_ref(list,ref,cgpara1);
- paramanager.freeparaloc(list,cgpara1);
- paramanager.freeparaloc(list,cgpara2);
- allocallcpuregisters(list);
- a_call_name(list,'FPC_FINALIZE');
- deallocallcpuregisters(list);
- end;
- cgpara1.done;
- cgpara2.done;
- end;
- procedure tcg.g_rangecheck(list: TAsmList; const l:tlocation;fromdef,todef: tdef);
- { generate range checking code for the value at location p. The type }
- { type used is checked against todefs ranges. fromdef (p.resulttype.def) }
- { is the original type used at that location. When both defs are equal }
- { the check is also insert (needed for succ,pref,inc,dec) }
- const
- aintmax=high(aint);
- var
- neglabel : tasmlabel;
- hreg : tregister;
- lto,hto,
- lfrom,hfrom : TConstExprInt;
- fromsize, tosize: cardinal;
- from_signed, to_signed: boolean;
- begin
- { range checking on and range checkable value? }
- if not(cs_check_range in aktlocalswitches) or
- not(fromdef.deftype in [orddef,enumdef]) then
- exit;
- {$ifndef cpu64bit}
- { handle 64bit rangechecks separate for 32bit processors }
- if is_64bit(fromdef) or is_64bit(todef) then
- begin
- cg64.g_rangecheck64(list,l,fromdef,todef);
- exit;
- end;
- {$endif cpu64bit}
- { only check when assigning to scalar, subranges are different, }
- { when todef=fromdef then the check is always generated }
- getrange(fromdef,lfrom,hfrom);
- getrange(todef,lto,hto);
- from_signed := is_signed(fromdef);
- to_signed := is_signed(todef);
- { check the rangetype of the array, not the array itself }
- { (only change now, since getrange needs the arraydef) }
- if (todef.deftype = arraydef) then
- todef := tarraydef(todef).rangetype.def;
- { no range check if from and to are equal and are both longint/dword }
- { no range check if from and to are equal and are both longint/dword }
- { (if we have a 32bit processor) or int64/qword, since such }
- { operations can at most cause overflows (JM) }
- { Note that these checks are mostly processor independent, they only }
- { have to be changed once we introduce 64bit subrange types }
- {$ifdef cpu64bit}
- if (fromdef = todef) and
- (fromdef.deftype=orddef) and
- (((((torddef(fromdef).typ = s64bit) and
- (lfrom = low(int64)) and
- (hfrom = high(int64))) or
- ((torddef(fromdef).typ = u64bit) and
- (lfrom = low(qword)) and
- (hfrom = high(qword))) or
- ((torddef(fromdef).typ = scurrency) and
- (lfrom = low(int64)) and
- (hfrom = high(int64)))))) then
- exit;
- {$else cpu64bit}
- if (fromdef = todef) and
- (fromdef.deftype=orddef) and
- (((((torddef(fromdef).typ = s32bit) and
- (lfrom = low(longint)) and
- (hfrom = high(longint))) or
- ((torddef(fromdef).typ = u32bit) and
- (lfrom = low(cardinal)) and
- (hfrom = high(cardinal)))))) then
- exit;
- {$endif cpu64bit}
- { optimize some range checks away in safe cases }
- fromsize := fromdef.size;
- tosize := todef.size;
- if ((from_signed = to_signed) or
- (not from_signed)) and
- (lto<=lfrom) and (hto>=hfrom) and
- (fromsize <= tosize) then
- begin
- { if fromsize < tosize, and both have the same signed-ness or }
- { fromdef is unsigned, then all bit patterns from fromdef are }
- { valid for todef as well }
- if (fromsize < tosize) then
- exit;
- if (fromsize = tosize) and
- (from_signed = to_signed) then
- { only optimize away if all bit patterns which fit in fromsize }
- { are valid for the todef }
- begin
- {$ifopt Q+}
- {$define overflowon}
- {$Q-}
- {$endif}
- if to_signed then
- begin
- { calculation of the low/high ranges must not overflow 64 bit
- otherwise we end up comparing with zero for 64 bit data types on
- 64 bit processors }
- if (lto = (int64(-1) << (tosize * 8 - 1))) and
- (hto = (-((int64(-1) << (tosize * 8 - 1))+1))) then
- exit
- end
- else
- begin
- { calculation of the low/high ranges must not overflow 64 bit
- otherwise we end up having all zeros for 64 bit data types on
- 64 bit processors }
- if (lto = 0) and
- (qword(hto) = (qword(-1) >> (64-(tosize * 8))) ) then
- exit
- end;
- {$ifdef overflowon}
- {$Q+}
- {$undef overflowon}
- {$endif}
- end
- end;
- { generate the rangecheck code for the def where we are going to }
- { store the result }
- { use the trick that }
- { a <= x <= b <=> 0 <= x-a <= b-a <=> unsigned(x-a) <= unsigned(b-a) }
- { To be able to do that, we have to make sure however that either }
- { fromdef and todef are both signed or unsigned, or that we leave }
- { the parts < 0 and > maxlongint out }
- if from_signed xor to_signed then
- begin
- if from_signed then
- { from is signed, to is unsigned }
- begin
- { if high(from) < 0 -> always range error }
- if (hfrom < 0) or
- { if low(to) > maxlongint also range error }
- (lto > aintmax) then
- begin
- a_call_name(list,'FPC_RANGEERROR');
- exit
- end;
- { from is signed and to is unsigned -> when looking at to }
- { as an signed value, it must be < maxaint (otherwise }
- { it will become negative, which is invalid since "to" is unsigned) }
- if hto > aintmax then
- hto := aintmax;
- end
- else
- { from is unsigned, to is signed }
- begin
- if (lfrom > aintmax) or
- (hto < 0) then
- begin
- a_call_name(list,'FPC_RANGEERROR');
- exit
- end;
- { from is unsigned and to is signed -> when looking at to }
- { as an unsigned value, it must be >= 0 (since negative }
- { values are the same as values > maxlongint) }
- if lto < 0 then
- lto := 0;
- end;
- end;
- hreg:=getintregister(list,OS_INT);
- a_load_loc_reg(list,OS_INT,l,hreg);
- a_op_const_reg(list,OP_SUB,OS_INT,aint(lto),hreg);
- current_asmdata.getjumplabel(neglabel);
- {
- if from_signed then
- a_cmp_const_reg_label(list,OS_INT,OC_GTE,aint(hto-lto),hreg,neglabel)
- else
- }
- {$ifdef cpu64bit}
- if qword(hto-lto)>qword(aintmax) then
- a_cmp_const_reg_label(list,OS_INT,OC_BE,aintmax,hreg,neglabel)
- else
- {$endif cpu64bit}
- a_cmp_const_reg_label(list,OS_INT,OC_BE,aint(hto-lto),hreg,neglabel);
- a_call_name(list,'FPC_RANGEERROR');
- a_label(list,neglabel);
- end;
- procedure tcg.g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;ovloc : tlocation);
- begin
- g_overflowCheck(list,loc,def);
- end;
- 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;
- procedure tcg.g_maybe_testself(list : TAsmList;reg:tregister);
- var
- OKLabel : tasmlabel;
- cgpara1 : TCGPara;
- begin
- if (cs_check_object in aktlocalswitches) or
- (cs_check_range in aktlocalswitches) then
- begin
- current_asmdata.getjumplabel(oklabel);
- a_cmp_const_reg_label(list,OS_ADDR,OC_NE,0,reg,oklabel);
- cgpara1.init;
- paramanager.getintparaloc(pocall_default,1,cgpara1);
- paramanager.allocparaloc(list,cgpara1);
- a_param_const(list,OS_INT,210,cgpara1);
- paramanager.freeparaloc(list,cgpara1);
- a_call_name(list,'FPC_HANDLEERROR');
- a_label(list,oklabel);
- cgpara1.done;
- end;
- end;
- procedure tcg.g_maybe_testvmt(list : TAsmList;reg:tregister;objdef:tobjectdef);
- var
- hrefvmt : treference;
- cgpara1,cgpara2 : TCGPara;
- begin
- cgpara1.init;
- cgpara2.init;
- paramanager.getintparaloc(pocall_default,1,cgpara1);
- paramanager.getintparaloc(pocall_default,2,cgpara2);
- if (cs_check_object in aktlocalswitches) then
- begin
- reference_reset_symbol(hrefvmt,current_asmdata.RefAsmSymbol(objdef.vmt_mangledname),0);
- paramanager.allocparaloc(list,cgpara2);
- a_paramaddr_ref(list,hrefvmt,cgpara2);
- paramanager.allocparaloc(list,cgpara1);
- a_param_reg(list,OS_ADDR,reg,cgpara1);
- paramanager.freeparaloc(list,cgpara1);
- paramanager.freeparaloc(list,cgpara2);
- allocallcpuregisters(list);
- a_call_name(list,'FPC_CHECK_OBJECT_EXT');
- deallocallcpuregisters(list);
- end
- else
- if (cs_check_range in aktlocalswitches) then
- begin
- paramanager.allocparaloc(list,cgpara1);
- a_param_reg(list,OS_ADDR,reg,cgpara1);
- paramanager.freeparaloc(list,cgpara1);
- allocallcpuregisters(list);
- a_call_name(list,'FPC_CHECK_OBJECT');
- deallocallcpuregisters(list);
- end;
- cgpara1.done;
- cgpara2.done;
- end;
- {*****************************************************************************
- Entry/Exit Code Functions
- *****************************************************************************}
- procedure tcg.g_copyvaluepara_openarray(list : TAsmList;const ref:treference;const lenloc:tlocation;elesize:aint;destreg:tregister);
- var
- sizereg,sourcereg,lenreg : tregister;
- cgpara1,cgpara2,cgpara3 : TCGPara;
- begin
- { because some abis don't support dynamic stack allocation properly
- open array value parameters are copied onto the heap
- }
- { calculate necessary memory }
- { read/write operations on one register make the life of the register allocator hard }
- if not(lenloc.loc in [LOC_REGISTER,LOC_CREGISTER]) then
- begin
- lenreg:=getintregister(list,OS_INT);
- a_load_loc_reg(list,OS_INT,lenloc,lenreg);
- end
- else
- lenreg:=lenloc.register;
- sizereg:=getintregister(list,OS_INT);
- a_op_const_reg_reg(list,OP_ADD,OS_INT,1,lenreg,sizereg);
- a_op_const_reg(list,OP_IMUL,OS_INT,elesize,sizereg);
- { load source }
- sourcereg:=getaddressregister(list);
- a_loadaddr_ref_reg(list,ref,sourcereg);
- { do getmem call }
- cgpara1.init;
- paramanager.getintparaloc(pocall_default,1,cgpara1);
- paramanager.allocparaloc(list,cgpara1);
- a_param_reg(list,OS_INT,sizereg,cgpara1);
- paramanager.freeparaloc(list,cgpara1);
- allocallcpuregisters(list);
- a_call_name(list,'FPC_GETMEM');
- deallocallcpuregisters(list);
- cgpara1.done;
- { return the new address }
- a_load_reg_reg(list,OS_ADDR,OS_ADDR,NR_FUNCTION_RESULT_REG,destreg);
- { do move call }
- cgpara1.init;
- cgpara2.init;
- cgpara3.init;
- paramanager.getintparaloc(pocall_default,1,cgpara1);
- paramanager.getintparaloc(pocall_default,2,cgpara2);
- paramanager.getintparaloc(pocall_default,3,cgpara3);
- { load size }
- paramanager.allocparaloc(list,cgpara3);
- a_param_reg(list,OS_INT,sizereg,cgpara3);
- { load destination }
- paramanager.allocparaloc(list,cgpara2);
- a_param_reg(list,OS_ADDR,destreg,cgpara2);
- { load source }
- paramanager.allocparaloc(list,cgpara1);
- a_param_reg(list,OS_ADDR,sourcereg,cgpara1);
- paramanager.freeparaloc(list,cgpara3);
- paramanager.freeparaloc(list,cgpara2);
- paramanager.freeparaloc(list,cgpara1);
- allocallcpuregisters(list);
- a_call_name(list,'FPC_MOVE');
- deallocallcpuregisters(list);
- cgpara3.done;
- cgpara2.done;
- cgpara1.done;
- end;
- procedure tcg.g_releasevaluepara_openarray(list : TAsmList;const l:tlocation);
- var
- cgpara1 : TCGPara;
- begin
- { do move call }
- cgpara1.init;
- paramanager.getintparaloc(pocall_default,1,cgpara1);
- { load source }
- paramanager.allocparaloc(list,cgpara1);
- a_param_loc(list,l,cgpara1);
- paramanager.freeparaloc(list,cgpara1);
- allocallcpuregisters(list);
- a_call_name(list,'FPC_FREEMEM');
- deallocallcpuregisters(list);
- cgpara1.done;
- end;
- procedure tcg.g_save_standard_registers(list:TAsmList);
- var
- href : treference;
- size : longint;
- r : integer;
- begin
- { Get temp }
- 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 size>0 then
- begin
- tg.GetTemp(list,size,tt_noreuse,current_procinfo.save_regs_ref);
- { 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;
- end;
- end;
- procedure tcg.g_restore_standard_registers(list:TAsmList);
- var
- href : treference;
- r : integer;
- hreg : tregister;
- begin
- { 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;
- 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: aint);
- begin
- a_load_const_ref(list, OS_INT, a, href);
- end;
- procedure tcg.g_exception_reason_load(list : TAsmList; const href : treference);
- begin
- 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: aint);
- var
- hsym : tsym;
- href : treference;
- paraloc : tcgparalocation;
- begin
- { calculate the parameter info for the procdef }
- if not procdef.has_paraloc_info then
- begin
- procdef.requiredargarea:=paramanager.create_paraloc_info(procdef,callerside);
- procdef.has_paraloc_info:=true;
- end;
- hsym:=tsym(procdef.parast.search('self'));
- if not(assigned(hsym) and
- (hsym.typ=paravarsym)) then
- internalerror(200305251);
- paraloc:=tparavarsym(hsym).paraloc[callerside].location^;
- case paraloc.loc of
- LOC_REGISTER:
- cg.a_op_const_reg(list,OP_SUB,paraloc.size,ioffset,paraloc.register);
- LOC_REFERENCE:
- begin
- { offset in the wrapper needs to be adjusted for the stored
- return address }
- reference_reset_base(href,paraloc.reference.index,paraloc.reference.offset+sizeof(aint));
- cg.a_op_const_ref(list,OP_SUB,paraloc.size,ioffset,href);
- end
- else
- internalerror(200309189);
- end;
- end;
- procedure tcg.a_call_name_static(list : TAsmList;const s : string);
- begin
- a_call_name(list,s);
- end;
- function tcg.g_indirect_sym_load(list:TAsmList;const symname: string): tregister;
- var
- l: tasmsymbol;
- ref: treference;
- begin
- result := NR_NO;
- case target_info.system of
- system_powerpc_darwin,
- system_i386_darwin:
- begin
- l:=current_asmdata.getasmsymbol('L'+symname+'$non_lazy_ptr');
- if not(assigned(l)) then
- begin
- l:=current_asmdata.DefineAsmSymbol('L'+symname+'$non_lazy_ptr',AB_COMMON,AT_DATA);
- current_asmdata.asmlists[al_picdata].concat(tai_symbol.create(l,0));
- current_asmdata.asmlists[al_picdata].concat(tai_const.create_indirect_sym(current_asmdata.RefAsmSymbol(symname)));
- current_asmdata.asmlists[al_picdata].concat(tai_const.create_32bit(0));
- end;
- result := cg.getaddressregister(list);
- reference_reset_symbol(ref,l,0);
- { ref.base:=current_procinfo.got;
- ref.relsymbol:=current_procinfo.CurrGOTLabel;}
- cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,ref,result);
- end;
- end;
- end;
- {*****************************************************************************
- TCG64
- *****************************************************************************}
- {$ifndef cpu64bit}
- 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_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;
- {$endif cpu64bit}
- initialization
- ;
- finalization
- cg.free;
- {$ifndef cpu64bit}
- cg64.free;
- {$endif cpu64bit}
- end.
|