12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141 |
- {
- Copyright (c) 2003 by Florian Klaempfl
- Member of the Free Pascal development team
- This unit implements the code generator for the ARM
- 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.
- ****************************************************************************
- }
- unit cgcpu;
- {$i fpcdefs.inc}
- interface
- uses
- globtype,symtype,symdef,
- cgbase,cgutils,cgobj,
- aasmbase,aasmcpu,aasmtai,aasmdata,
- parabase,
- cpubase,cpuinfo,node,cg64f32,rgcpu;
- type
- tcgarm = class(tcg)
- { true, if the next arithmetic operation should modify the flags }
- cgsetflags : boolean;
- procedure init_register_allocators;override;
- procedure done_register_allocators;override;
- procedure a_param_const(list : TAsmList;size : tcgsize;a : aint;const paraloc : TCGPara);override;
- procedure a_param_ref(list : TAsmList;size : tcgsize;const r : treference;const paraloc : TCGPara);override;
- procedure a_paramaddr_ref(list : TAsmList;const r : treference;const paraloc : TCGPara);override;
- procedure a_call_name(list : TAsmList;const s : string);override;
- procedure a_call_reg(list : TAsmList;reg: tregister);override;
- procedure a_call_ref(list : TAsmList;ref: treference);override;
- procedure a_op_const_reg(list : TAsmList; Op: TOpCG; size: TCGSize; a: aint; reg: TRegister); override;
- procedure a_op_reg_reg(list : TAsmList; Op: TOpCG; size: TCGSize; src, dst: TRegister); override;
- procedure a_op_const_reg_reg(list: TAsmList; op: TOpCg;
- size: tcgsize; a: aint; src, dst: tregister); override;
- procedure a_op_reg_reg_reg(list: TAsmList; op: TOpCg;
- size: tcgsize; src1, src2, dst: tregister); override;
- procedure a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; a: aint; src, dst: tregister;setflags : boolean;var ovloc : tlocation);override;
- procedure a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; src1, src2, dst: tregister;setflags : boolean;var ovloc : tlocation);override;
- { move instructions }
- procedure a_load_const_reg(list : TAsmList; size: tcgsize; a : aint;reg : tregister);override;
- procedure a_load_reg_ref(list : TAsmList; fromsize, tosize: tcgsize; reg : tregister;const ref : treference);override;
- procedure a_load_ref_reg(list : TAsmList; fromsize, tosize : tcgsize;const Ref : treference;reg : tregister);override;
- procedure a_load_reg_reg(list : TAsmList; fromsize, tosize : tcgsize;reg1,reg2 : tregister);override;
- function a_internal_load_reg_ref(list : TAsmList; fromsize, tosize: tcgsize; reg : tregister;const ref : treference):treference;
- function a_internal_load_ref_reg(list : TAsmList; fromsize, tosize : tcgsize;const Ref : treference;reg : tregister):treference;
- { fpu move instructions }
- procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister); override;
- procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister); override;
- procedure a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference); override;
- procedure a_paramfpu_ref(list : TAsmList;size : tcgsize;const ref : treference;const paraloc : TCGPara);override;
- { comparison operations }
- procedure a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : aint;reg : tregister;
- l : tasmlabel);override;
- procedure a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); override;
- procedure a_jmp_name(list : TAsmList;const s : string); override;
- procedure a_jmp_always(list : TAsmList;l: tasmlabel); override;
- procedure a_jmp_flags(list : TAsmList;const f : TResFlags;l: tasmlabel); override;
- procedure g_flags2reg(list: TAsmList; size: TCgSize; const f: TResFlags; reg: TRegister); override;
- procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean);override;
- procedure g_proc_exit(list : TAsmList;parasize : longint;nostackframe:boolean); override;
- procedure a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);override;
- procedure g_concatcopy(list : TAsmList;const source,dest : treference;len : aint);override;
- procedure g_concatcopy_unaligned(list : TAsmList;const source,dest : treference;len : aint);override;
- procedure g_concatcopy_move(list : TAsmList;const source,dest : treference;len : aint);
- procedure g_concatcopy_internal(list : TAsmList;const source,dest : treference;len : aint;aligned : boolean);
- procedure g_overflowcheck(list: TAsmList; const l: tlocation; def: tdef); override;
- procedure g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;ovloc : tlocation);override;
- procedure g_save_standard_registers(list : TAsmList);override;
- procedure g_restore_standard_registers(list : TAsmList);override;
- procedure a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel);
- procedure fixref(list : TAsmList;var ref : treference);
- function handle_load_store(list:TAsmList;op: tasmop;oppostfix : toppostfix;reg:tregister;ref: treference):treference;
- procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
- end;
- tcg64farm = class(tcg64f32)
- procedure a_op64_reg_reg(list : TAsmList;op:TOpCG;size : tcgsize;regsrc,regdst : tregister64);override;
- procedure a_op64_const_reg(list : TAsmList;op:TOpCG;size : tcgsize;value : int64;reg : tregister64);override;
- procedure a_op64_const_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64);override;
- procedure a_op64_reg_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64);override;
- procedure a_op64_const_reg_reg_checkoverflow(list: TAsmList;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64;setflags : boolean;var ovloc : tlocation);override;
- procedure a_op64_reg_reg_reg_checkoverflow(list: TAsmList;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64;setflags : boolean;var ovloc : tlocation);override;
- end;
- const
- OpCmp2AsmCond : Array[topcmp] of TAsmCond = (C_NONE,C_EQ,C_GT,
- C_LT,C_GE,C_LE,C_NE,C_LS,C_CC,C_CS,C_HI);
- winstackpagesize = 4096;
- function get_fpu_postfix(def : tdef) : toppostfix;
- implementation
- uses
- globals,verbose,systems,cutils,
- fmodule,
- symconst,symsym,
- tgobj,
- procinfo,cpupi,
- paramgr;
- function get_fpu_postfix(def : tdef) : toppostfix;
- begin
- if def.typ=floatdef then
- begin
- case tfloatdef(def).floattype of
- s32real:
- result:=PF_S;
- s64real:
- result:=PF_D;
- s80real:
- result:=PF_E;
- else
- internalerror(200401272);
- end;
- end
- else
- internalerror(200401271);
- end;
- procedure tcgarm.init_register_allocators;
- begin
- inherited init_register_allocators;
- { currently, we save R14 always, so we can use it }
- rg[R_INTREGISTER]:=trgintcpu.create(R_INTREGISTER,R_SUBWHOLE,
- [RS_R0,RS_R1,RS_R2,RS_R3,RS_R4,RS_R5,RS_R6,RS_R7,RS_R8,
- RS_R9,RS_R10,RS_R12,RS_R14],first_int_imreg,[]);
- rg[R_FPUREGISTER]:=trgcpu.create(R_FPUREGISTER,R_SUBNONE,
- [RS_F0,RS_F1,RS_F2,RS_F3,RS_F4,RS_F5,RS_F6,RS_F7],first_fpu_imreg,[]);
- rg[R_MMREGISTER]:=trgcpu.create(R_MMREGISTER,R_SUBNONE,
- [RS_S0,RS_S1,RS_R2,RS_R3,RS_R4,RS_S31],first_mm_imreg,[]);
- end;
- procedure tcgarm.done_register_allocators;
- begin
- rg[R_INTREGISTER].free;
- rg[R_FPUREGISTER].free;
- rg[R_MMREGISTER].free;
- inherited done_register_allocators;
- end;
- procedure tcgarm.a_param_const(list : TAsmList;size : tcgsize;a : aint;const paraloc : TCGPara);
- var
- ref: treference;
- begin
- paraloc.check_simple_location;
- case paraloc.location^.loc of
- LOC_REGISTER,LOC_CREGISTER:
- a_load_const_reg(list,size,a,paraloc.location^.register);
- LOC_REFERENCE:
- begin
- reference_reset(ref);
- ref.base:=paraloc.location^.reference.index;
- ref.offset:=paraloc.location^.reference.offset;
- a_load_const_ref(list,size,a,ref);
- end;
- else
- internalerror(2002081101);
- end;
- end;
- procedure tcgarm.a_param_ref(list : TAsmList;size : tcgsize;const r : treference;const paraloc : TCGPara);
- var
- tmpref, ref: treference;
- location: pcgparalocation;
- sizeleft: aint;
- begin
- location := paraloc.location;
- tmpref := r;
- sizeleft := paraloc.intsize;
- while assigned(location) do
- begin
- case location^.loc of
- LOC_REGISTER,LOC_CREGISTER:
- a_load_ref_reg(list,location^.size,location^.size,tmpref,location^.register);
- LOC_REFERENCE:
- begin
- reference_reset_base(ref,location^.reference.index,location^.reference.offset);
- { doubles in softemu mode have a strange order of registers and references }
- if location^.size=OS_32 then
- g_concatcopy(list,tmpref,ref,4)
- else
- begin
- g_concatcopy(list,tmpref,ref,sizeleft);
- if assigned(location^.next) then
- internalerror(2005010710);
- end;
- end;
- LOC_FPUREGISTER,LOC_CFPUREGISTER:
- case location^.size of
- OS_F32, OS_F64:
- a_loadfpu_ref_reg(list,location^.size,location^.size,tmpref,location^.register);
- else
- internalerror(2002072801);
- end;
- LOC_VOID:
- begin
- // nothing to do
- end;
- else
- internalerror(2002081103);
- end;
- inc(tmpref.offset,tcgsize2size[location^.size]);
- dec(sizeleft,tcgsize2size[location^.size]);
- location := location^.next;
- end;
- end;
- procedure tcgarm.a_paramaddr_ref(list : TAsmList;const r : treference;const paraloc : TCGPara);
- var
- ref: treference;
- tmpreg: tregister;
- begin
- paraloc.check_simple_location;
- case paraloc.location^.loc of
- LOC_REGISTER,LOC_CREGISTER:
- a_loadaddr_ref_reg(list,r,paraloc.location^.register);
- LOC_REFERENCE:
- begin
- reference_reset(ref);
- ref.base := paraloc.location^.reference.index;
- ref.offset := paraloc.location^.reference.offset;
- tmpreg := getintregister(list,OS_ADDR);
- a_loadaddr_ref_reg(list,r,tmpreg);
- a_load_reg_ref(list,OS_ADDR,OS_ADDR,tmpreg,ref);
- end;
- else
- internalerror(2002080701);
- end;
- end;
- procedure tcgarm.a_call_name(list : TAsmList;const s : string);
- begin
- list.concat(taicpu.op_sym(A_BL,current_asmdata.RefAsmSymbol(s)));
- {
- the compiler does not properly set this flag anymore in pass 1, and
- for now we only need it after pass 2 (I hope) (JM)
- if not(pi_do_call in current_procinfo.flags) then
- internalerror(2003060703);
- }
- include(current_procinfo.flags,pi_do_call);
- end;
- procedure tcgarm.a_call_reg(list : TAsmList;reg: tregister);
- begin
- list.concat(taicpu.op_reg_reg(A_MOV,NR_R14,NR_PC));
- list.concat(taicpu.op_reg_reg(A_MOV,NR_PC,reg));
- {
- the compiler does not properly set this flag anymore in pass 1, and
- for now we only need it after pass 2 (I hope) (JM)
- if not(pi_do_call in current_procinfo.flags) then
- internalerror(2003060703);
- }
- include(current_procinfo.flags,pi_do_call);
- end;
- procedure tcgarm.a_call_ref(list : TAsmList;ref: treference);
- begin
- a_reg_alloc(list,NR_R12);
- a_load_ref_reg(list,OS_ADDR,OS_ADDR,ref,NR_R12);
- list.concat(taicpu.op_reg_reg(A_MOV,NR_R14,NR_PC));
- list.concat(taicpu.op_reg_reg(A_MOV,NR_PC,NR_R12));
- a_reg_dealloc(list,NR_R12);
- include(current_procinfo.flags,pi_do_call);
- end;
- procedure tcgarm.a_op_const_reg(list : TAsmList; Op: TOpCG; size: TCGSize; a: aint; reg: TRegister);
- begin
- a_op_const_reg_reg(list,op,size,a,reg,reg);
- end;
- procedure tcgarm.a_op_reg_reg(list : TAsmList; Op: TOpCG; size: TCGSize; src, dst: TRegister);
- begin
- case op of
- OP_NEG:
- list.concat(taicpu.op_reg_reg_const(A_RSB,dst,src,0));
- OP_NOT:
- begin
- list.concat(taicpu.op_reg_reg(A_MVN,dst,src));
- case size of
- OS_8 :
- a_op_const_reg_reg(list,OP_AND,OS_INT,$ff,dst,dst);
- OS_16 :
- a_op_const_reg_reg(list,OP_AND,OS_INT,$ffff,dst,dst);
- end;
- end
- else
- a_op_reg_reg_reg(list,op,OS_32,src,dst,dst);
- end;
- end;
- const
- op_reg_reg_opcg2asmop: array[TOpCG] of tasmop =
- (A_NONE,A_MOV,A_ADD,A_AND,A_NONE,A_NONE,A_MUL,A_MUL,A_NONE,A_NONE,A_ORR,
- A_NONE,A_NONE,A_NONE,A_SUB,A_EOR);
- procedure tcgarm.a_op_const_reg_reg(list: TAsmList; op: TOpCg;
- size: tcgsize; a: aint; src, dst: tregister);
- var
- ovloc : tlocation;
- begin
- a_op_const_reg_reg_checkoverflow(list,op,size,a,src,dst,false,ovloc);
- end;
- procedure tcgarm.a_op_reg_reg_reg(list: TAsmList; op: TOpCg;
- size: tcgsize; src1, src2, dst: tregister);
- var
- ovloc : tlocation;
- begin
- a_op_reg_reg_reg_checkoverflow(list,op,size,src1,src2,dst,false,ovloc);
- end;
- procedure tcgarm.a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; a: aint; src, dst: tregister;setflags : boolean;var ovloc : tlocation);
- var
- shift : byte;
- tmpreg : tregister;
- so : tshifterop;
- l1 : longint;
- begin
- ovloc.loc:=LOC_VOID;
- if is_shifter_const(-a,shift) then
- case op of
- OP_ADD:
- begin
- op:=OP_SUB;
- a:=aint(dword(-a));
- end;
- OP_SUB:
- begin
- op:=OP_ADD;
- a:=aint(dword(-a));
- end
- end;
- if is_shifter_const(a,shift) and not(op in [OP_IMUL,OP_MUL]) then
- case op of
- OP_NEG,OP_NOT,
- OP_DIV,OP_IDIV:
- internalerror(200308281);
- OP_SHL:
- begin
- if a>32 then
- internalerror(200308294);
- if a<>0 then
- begin
- shifterop_reset(so);
- so.shiftmode:=SM_LSL;
- so.shiftimm:=a;
- list.concat(taicpu.op_reg_reg_shifterop(A_MOV,dst,src,so));
- end
- else
- list.concat(taicpu.op_reg_reg(A_MOV,dst,src));
- end;
- OP_SHR:
- begin
- if a>32 then
- internalerror(200308292);
- shifterop_reset(so);
- if a<>0 then
- begin
- so.shiftmode:=SM_LSR;
- so.shiftimm:=a;
- list.concat(taicpu.op_reg_reg_shifterop(A_MOV,dst,src,so));
- end
- else
- list.concat(taicpu.op_reg_reg(A_MOV,dst,src));
- end;
- OP_SAR:
- begin
- if a>32 then
- internalerror(200308295);
- if a<>0 then
- begin
- shifterop_reset(so);
- so.shiftmode:=SM_ASR;
- so.shiftimm:=a;
- list.concat(taicpu.op_reg_reg_shifterop(A_MOV,dst,src,so));
- end
- else
- list.concat(taicpu.op_reg_reg(A_MOV,dst,src));
- end;
- else
- list.concat(setoppostfix(
- taicpu.op_reg_reg_const(op_reg_reg_opcg2asmop[op],dst,src,a),toppostfix(ord(cgsetflags or setflags)*ord(PF_S))
- ));
- if (cgsetflags or setflags) and (size in [OS_8,OS_16,OS_32]) then
- begin
- ovloc.loc:=LOC_FLAGS;
- case op of
- OP_ADD:
- ovloc.resflags:=F_CS;
- OP_SUB:
- ovloc.resflags:=F_CC;
- end;
- end;
- end
- else
- begin
- { there could be added some more sophisticated optimizations }
- if (op in [OP_MUL,OP_IMUL]) and (a=1) then
- a_load_reg_reg(list,size,size,src,dst)
- else if (op in [OP_MUL,OP_IMUL]) and (a=0) then
- a_load_const_reg(list,size,0,dst)
- else if (op in [OP_IMUL]) and (a=-1) then
- a_op_reg_reg(list,OP_NEG,size,src,dst)
- { we do this here instead in the peephole optimizer because
- it saves us a register }
- else if (op in [OP_MUL,OP_IMUL]) and ispowerof2(a,l1) and not(cgsetflags or setflags) then
- a_op_const_reg_reg(list,OP_SHL,size,l1,src,dst)
- { for example : b=a*5 -> b=a*4+a with add instruction and shl }
- else if (op in [OP_MUL,OP_IMUL]) and ispowerof2(a-1,l1) and not(cgsetflags or setflags) then
- begin
- if l1>32 then{roozbeh does this ever happen?}
- internalerror(200308296);
- shifterop_reset(so);
- so.shiftmode:=SM_LSL;
- so.shiftimm:=l1;
- list.concat(taicpu.op_reg_reg_reg_shifterop(A_ADD,dst,src,src,so));
- end
- else
- begin
- tmpreg:=getintregister(list,size);
- a_load_const_reg(list,size,a,tmpreg);
- a_op_reg_reg_reg_checkoverflow(list,op,size,tmpreg,src,dst,setflags,ovloc);
- end;
- end;
- end;
- procedure tcgarm.a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; src1, src2, dst: tregister;setflags : boolean;var ovloc : tlocation);
- var
- so : tshifterop;
- tmpreg,overflowreg : tregister;
- asmop : tasmop;
- begin
- ovloc.loc:=LOC_VOID;
- case op of
- OP_NEG,OP_NOT,
- OP_DIV,OP_IDIV:
- internalerror(200308281);
- OP_SHL:
- begin
- shifterop_reset(so);
- so.rs:=src1;
- so.shiftmode:=SM_LSL;
- list.concat(taicpu.op_reg_reg_shifterop(A_MOV,dst,src2,so));
- end;
- OP_SHR:
- begin
- shifterop_reset(so);
- so.rs:=src1;
- so.shiftmode:=SM_LSR;
- list.concat(taicpu.op_reg_reg_shifterop(A_MOV,dst,src2,so));
- end;
- OP_SAR:
- begin
- shifterop_reset(so);
- so.rs:=src1;
- so.shiftmode:=SM_ASR;
- list.concat(taicpu.op_reg_reg_shifterop(A_MOV,dst,src2,so));
- end;
- OP_IMUL,
- OP_MUL:
- begin
- if cgsetflags or setflags then
- begin
- overflowreg:=getintregister(list,size);
- if op=OP_IMUL then
- asmop:=A_SMULL
- else
- asmop:=A_UMULL;
- { the arm doesn't allow that rd and rm are the same }
- if dst=src2 then
- begin
- if dst<>src1 then
- list.concat(taicpu.op_reg_reg_reg_reg(asmop,dst,overflowreg,src1,src2))
- else
- begin
- tmpreg:=getintregister(list,size);
- a_load_reg_reg(list,size,size,src2,dst);
- list.concat(taicpu.op_reg_reg_reg_reg(asmop,dst,overflowreg,tmpreg,src1));
- end;
- end
- else
- list.concat(taicpu.op_reg_reg_reg_reg(asmop,dst,overflowreg,src2,src1));
- if op=OP_IMUL then
- begin
- shifterop_reset(so);
- so.shiftmode:=SM_ASR;
- so.shiftimm:=31;
- list.concat(taicpu.op_reg_reg_shifterop(A_CMP,overflowreg,dst,so));
- end
- else
- list.concat(taicpu.op_reg_const(A_CMP,overflowreg,0));
- ovloc.loc:=LOC_FLAGS;
- ovloc.resflags:=F_NE;
- end
- else
- begin
- { the arm doesn't allow that rd and rm are the same }
- if dst=src2 then
- begin
- if dst<>src1 then
- list.concat(taicpu.op_reg_reg_reg(A_MUL,dst,src1,src2))
- else
- begin
- tmpreg:=getintregister(list,size);
- a_load_reg_reg(list,size,size,src2,dst);
- list.concat(taicpu.op_reg_reg_reg(A_MUL,dst,tmpreg,src1));
- end;
- end
- else
- list.concat(taicpu.op_reg_reg_reg(A_MUL,dst,src2,src1));
- end;
- end;
- else
- list.concat(setoppostfix(
- taicpu.op_reg_reg_reg(op_reg_reg_opcg2asmop[op],dst,src2,src1),toppostfix(ord(cgsetflags or setflags)*ord(PF_S))
- ));
- end;
- end;
- procedure tcgarm.a_load_const_reg(list : TAsmList; size: tcgsize; a : aint;reg : tregister);
- var
- imm_shift : byte;
- l : tasmlabel;
- hr : treference;
- begin
- if not(size in [OS_8,OS_S8,OS_16,OS_S16,OS_32,OS_S32]) then
- internalerror(2002090902);
- if is_shifter_const(a,imm_shift) then
- list.concat(taicpu.op_reg_const(A_MOV,reg,a))
- else if is_shifter_const(not(a),imm_shift) then
- list.concat(taicpu.op_reg_const(A_MVN,reg,not(a)))
- { loading of constants with mov and orr }
- {else [if (is_shifter_const(a-byte(a),imm_shift)) then
- begin
- }{ roozbeh:why using tmpreg later causes error in compiling of system.pp,and also those other similars}
- {list.concat(taicpu.op_reg_const(A_MOV,reg,a-byte(a)));
- list.concat(taicpu.op_reg_reg_const(A_ORR,reg,reg,byte(a)));
- end
- else if (is_shifter_const(a-word(a),imm_shift)) and (is_shifter_const(word(a),imm_shift)) then
- begin
- list.concat(taicpu.op_reg_const(A_MOV,reg,a-word(a)));
- list.concat(taicpu.op_reg_reg_const(A_ORR,reg,reg,word(a)));
- end
- else if (is_shifter_const(a-(longint(a) shl 8) shr 8,imm_shift)) and (is_shifter_const((longint(a) shl 8) shr 8,imm_shift)) then
- begin
- list.concat(taicpu.op_reg_const(A_MOV,reg,a-(longint(a) shl 8)shr 8));
- list.concat(taicpu.op_reg_reg_const(A_ORR,reg,reg,(longint(a) shl 8)shr 8));
- end}
- else
- begin
- reference_reset(hr);
- current_asmdata.getjumplabel(l);
- cg.a_label(current_procinfo.aktlocaldata,l);
- hr.symboldata:=current_procinfo.aktlocaldata.last;
- current_procinfo.aktlocaldata.concat(tai_const.Create_32bit(longint(a)));
- hr.symbol:=l;
- list.concat(taicpu.op_reg_ref(A_LDR,reg,hr));
- end;
- end;
- function tcgarm.handle_load_store(list:TAsmList;op: tasmop;oppostfix : toppostfix;reg:tregister;ref: treference):treference;
- var
- tmpreg : tregister;
- tmpref : treference;
- l : tasmlabel;
- begin
- tmpreg:=NR_NO;
- { Be sure to have a base register }
- if (ref.base=NR_NO) then
- begin
- if ref.shiftmode<>SM_None then
- internalerror(200308294);
- ref.base:=ref.index;
- ref.index:=NR_NO;
- end;
- { absolute symbols can't be handled directly, we've to store the symbol reference
- in the text segment and access it pc relative
- For now, we assume that references where base or index equals to PC are already
- relative, all other references are assumed to be absolute and thus they need
- to be handled extra.
- A proper solution would be to change refoptions to a set and store the information
- if the symbol is absolute or relative there.
- }
- if (assigned(ref.symbol) and
- not(is_pc(ref.base)) and
- not(is_pc(ref.index))
- ) or
- { [#xxx] isn't a valid address operand }
- ((ref.base=NR_NO) and (ref.index=NR_NO)) or
- (ref.offset<-4095) or
- (ref.offset>4095) or
- ((oppostfix in [PF_SB,PF_H,PF_SH]) and
- ((ref.offset<-255) or
- (ref.offset>255)
- )
- ) or
- ((op in [A_LDF,A_STF]) and
- ((ref.offset<-1020) or
- (ref.offset>1020) or
- { the usual pc relative symbol handling assumes possible offsets of +/- 4095 }
- assigned(ref.symbol)
- )
- ) then
- begin
- reference_reset(tmpref);
- { load symbol }
- tmpreg:=getintregister(list,OS_INT);
- if assigned(ref.symbol) then
- begin
- current_asmdata.getjumplabel(l);
- cg.a_label(current_procinfo.aktlocaldata,l);
- tmpref.symboldata:=current_procinfo.aktlocaldata.last;
- current_procinfo.aktlocaldata.concat(tai_const.create_sym_offset(ref.symbol,ref.offset));
- { load consts entry }
- tmpref.symbol:=l;
- tmpref.base:=NR_R15;
- list.concat(taicpu.op_reg_ref(A_LDR,tmpreg,tmpref));
- { in case of LDF/STF, we got rid of the NR_R15 }
- if is_pc(ref.base) then
- ref.base:=NR_NO;
- if is_pc(ref.index) then
- ref.index:=NR_NO;
- end
- else
- a_load_const_reg(list,OS_ADDR,ref.offset,tmpreg);
- if (ref.base<>NR_NO) then
- begin
- if ref.index<>NR_NO then
- begin
- list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.base,tmpreg));
- ref.base:=tmpreg;
- end
- else
- begin
- ref.index:=tmpreg;
- ref.shiftimm:=0;
- ref.signindex:=1;
- ref.shiftmode:=SM_None;
- end;
- end
- else
- ref.base:=tmpreg;
- ref.offset:=0;
- ref.symbol:=nil;
- end;
- if (ref.base<>NR_NO) and (ref.index<>NR_NO) and (ref.offset<>0) then
- begin
- if tmpreg<>NR_NO then
- a_op_const_reg_reg(list,OP_ADD,OS_ADDR,ref.offset,tmpreg,tmpreg)
- else
- begin
- tmpreg:=getintregister(list,OS_ADDR);
- a_op_const_reg_reg(list,OP_ADD,OS_ADDR,ref.offset,ref.base,tmpreg);
- ref.base:=tmpreg;
- end;
- ref.offset:=0;
- end;
- { floating point operations have only limited references
- we expect here, that a base is already set }
- if (op in [A_LDF,A_STF]) and (ref.index<>NR_NO) then
- begin
- if ref.shiftmode<>SM_none then
- internalerror(200309121);
- if tmpreg<>NR_NO then
- begin
- if ref.base=tmpreg then
- begin
- if ref.signindex<0 then
- list.concat(taicpu.op_reg_reg_reg(A_SUB,tmpreg,tmpreg,ref.index))
- else
- list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,tmpreg,ref.index));
- ref.index:=NR_NO;
- end
- else
- begin
- if ref.index<>tmpreg then
- internalerror(200403161);
- if ref.signindex<0 then
- list.concat(taicpu.op_reg_reg_reg(A_SUB,tmpreg,ref.base,tmpreg))
- else
- list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.base,tmpreg));
- ref.base:=tmpreg;
- ref.index:=NR_NO;
- end;
- end
- else
- begin
- tmpreg:=getintregister(list,OS_ADDR);
- list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.base,ref.index));
- ref.base:=tmpreg;
- ref.index:=NR_NO;
- end;
- end;
- list.concat(setoppostfix(taicpu.op_reg_ref(op,reg,ref),oppostfix));
- Result := ref;
- end;
- procedure tcgarm.a_load_reg_ref(list : TAsmList; fromsize, tosize: tcgsize; reg : tregister;const ref : treference);
- var
- oppostfix:toppostfix;
- usedtmpref: treference;
- tmpreg : tregister;
- so : tshifterop;
- begin
- case ToSize of
- { signed integer registers }
- OS_8,
- OS_S8:
- oppostfix:=PF_B;
- OS_16,
- OS_S16:
- oppostfix:=PF_H;
- OS_32,
- OS_S32:
- oppostfix:=PF_None;
- else
- InternalError(200308295);
- end;
- if ref.alignment<>0 then
- begin
- case FromSize of
- OS_16,OS_S16:
- begin
- shifterop_reset(so);so.shiftmode:=SM_LSR;so.shiftimm:=8;
- tmpreg:=getintregister(list,OS_INT);
- usedtmpref:=a_internal_load_reg_ref(list,OS_8,OS_8,reg,Ref);
- inc(usedtmpref.offset);
- list.concat(taicpu.op_reg_reg_shifterop(A_MOV,tmpreg,reg,so));
- a_internal_load_reg_ref(list,OS_8,OS_8,tmpreg,usedtmpref);
- end;
- OS_32,OS_S32:
- begin
- shifterop_reset(so);so.shiftmode:=SM_LSR;so.shiftimm:=8;
- tmpreg:=getintregister(list,OS_INT);
- usedtmpref:=a_internal_load_reg_ref(list,OS_8,OS_8,reg,Ref);
- list.concat(taicpu.op_reg_reg_shifterop(A_MOV,tmpreg,reg,so));
- inc(usedtmpref.offset);
- a_internal_load_reg_ref(list,OS_8,OS_8,tmpreg,usedtmpref);
- list.concat(taicpu.op_reg_reg_shifterop(A_MOV,tmpreg,tmpreg,so));
- inc(usedtmpref.offset);
- a_internal_load_reg_ref(list,OS_8,OS_8,tmpreg,usedtmpref);
- list.concat(taicpu.op_reg_reg_shifterop(A_MOV,tmpreg,tmpreg,so));
- inc(usedtmpref.offset);
- a_internal_load_reg_ref(list,OS_8,OS_8,tmpreg,usedtmpref);
- end
- else
- handle_load_store(list,A_STR,oppostfix,reg,ref);
- end;
- end
- else
- handle_load_store(list,A_STR,oppostfix,reg,ref);
- end;
- procedure tcgarm.a_load_ref_reg(list : TAsmList; fromsize, tosize : tcgsize;const Ref : treference;reg : tregister);
- var
- oppostfix:toppostfix;
- usedtmpref: treference;
- tmpreg,tmpreg2,tmpreg3 : tregister;
- so : tshifterop;
- begin
- case FromSize of
- { signed integer registers }
- OS_8:
- oppostfix:=PF_B;
- OS_S8:
- oppostfix:=PF_SB;
- OS_16:
- oppostfix:=PF_H;
- OS_S16:
- oppostfix:=PF_SH;
- OS_32,
- OS_S32:
- oppostfix:=PF_None;
- else
- InternalError(200308297);
- end;
- if Ref.alignment<>0 then
- begin
- case FromSize of
- OS_16,OS_S16:
- begin
- { only complicated references need an extra loadaddr }
- if assigned(ref.symbol) or
- (ref.index<>NR_NO) or
- (ref.offset<-4095) or
- (ref.offset>4094) or
- { sometimes the compiler reused registers }
- (reg=ref.index) or
- (reg=ref.base) then
- begin
- tmpreg3:=getintregister(list,OS_INT);
- a_loadaddr_ref_reg(list,ref,tmpreg3);
- reference_reset_base(usedtmpref,tmpreg3,0);
- end
- else
- usedtmpref:=ref;
- shifterop_reset(so);so.shiftmode:=SM_LSL;so.shiftimm:=8;
- tmpreg:=getintregister(list,OS_INT);
- a_internal_load_ref_reg(list,OS_8,OS_8,usedtmpref,tmpreg);
- inc(usedtmpref.offset);
- tmpreg2:=getintregister(list,OS_INT);
- if FromSize=OS_16 then
- a_internal_load_ref_reg(list,OS_8,OS_8,usedtmpref,tmpreg2)
- else
- a_internal_load_ref_reg(list,OS_S8,OS_S8,usedtmpref,tmpreg2);
- list.concat(taicpu.op_reg_reg_reg_shifterop(A_ORR,reg,tmpreg,tmpreg2,so));
- end;
- OS_32,OS_S32:
- begin
- tmpreg:=getintregister(list,OS_INT);
- tmpreg2:=getintregister(list,OS_INT);
- { only complicated references need an extra loadaddr }
- if assigned(ref.symbol) or
- (ref.index<>NR_NO) or
- (ref.offset<-4095) or
- (ref.offset>4092) or
- { sometimes the compiler reused registers }
- (reg=ref.index) or
- (reg=ref.base) then
- begin
- tmpreg3:=getintregister(list,OS_INT);
- a_loadaddr_ref_reg(list,ref,tmpreg3);
- reference_reset_base(usedtmpref,tmpreg3,0);
- end
- else
- usedtmpref:=ref;
- shifterop_reset(so);so.shiftmode:=SM_LSL;so.shiftimm:=8;
- a_internal_load_ref_reg(list,OS_8,OS_8,usedtmpref,reg);
- inc(usedtmpref.offset);
- a_internal_load_ref_reg(list,OS_8,OS_8,usedtmpref,tmpreg);
- list.concat(taicpu.op_reg_reg_reg_shifterop(A_ORR,tmpreg2,reg,tmpreg,so));
- inc(usedtmpref.offset);
- a_internal_load_ref_reg(list,OS_8,OS_8,usedtmpref,reg);
- so.shiftimm:=16;
- list.concat(taicpu.op_reg_reg_reg_shifterop(A_ORR,tmpreg,tmpreg2,reg,so));
- inc(usedtmpref.offset);
- a_internal_load_ref_reg(list,OS_8,OS_8,usedtmpref,tmpreg2);
- so.shiftimm:=24;
- list.concat(taicpu.op_reg_reg_reg_shifterop(A_ORR,reg,tmpreg,tmpreg2,so));
- end
- else
- handle_load_store(list,A_LDR,oppostfix,reg,ref);
- end;
- end
- else
- handle_load_store(list,A_LDR,oppostfix,reg,ref);
- end;
- function tcgarm.a_internal_load_reg_ref(list : TAsmList; fromsize, tosize: tcgsize; reg : tregister;const ref : treference):treference;
- var
- oppostfix:toppostfix;
- begin
- case ToSize of
- { signed integer registers }
- OS_8,
- OS_S8:
- oppostfix:=PF_B;
- OS_16,
- OS_S16:
- oppostfix:=PF_H;
- OS_32,
- OS_S32:
- oppostfix:=PF_None;
- else
- InternalError(2003082910);
- end;
- result:=handle_load_store(list,A_STR,oppostfix,reg,ref);
- end;
- function tcgarm.a_internal_load_ref_reg(list : TAsmList; fromsize, tosize : tcgsize;const Ref : treference;reg : tregister):treference;
- var
- oppostfix:toppostfix;
- begin
- case FromSize of
- { signed integer registers }
- OS_8:
- oppostfix:=PF_B;
- OS_S8:
- oppostfix:=PF_SB;
- OS_16:
- oppostfix:=PF_H;
- OS_S16:
- oppostfix:=PF_SH;
- OS_32,
- OS_S32:
- oppostfix:=PF_None;
- else
- InternalError(200308291);
- end;
- result:=handle_load_store(list,A_LDR,oppostfix,reg,ref);
- end;
- procedure tcgarm.a_load_reg_reg(list : TAsmList; fromsize, tosize : tcgsize;reg1,reg2 : tregister);
- var
- so : tshifterop;
- conv_done: boolean;
- procedure do_shift(shiftmode : tshiftmode; shiftimm : byte; reg : tregister);
- begin
- so.shiftmode:=shiftmode;
- so.shiftimm:=shiftimm;
- list.concat(taicpu.op_reg_reg_shifterop(A_MOV,reg2,reg,so));
- end;
- function do_conv(size : tcgsize) : boolean;
- begin
- result:=true;
- case size of
- OS_8:
- list.concat(taicpu.op_reg_reg_const(A_AND,reg2,reg1,$ff));
- OS_S8:
- begin
- do_shift(SM_LSL,24,reg1);
- do_shift(SM_ASR,24,reg2);
- end;
- OS_16,OS_S16:
- begin
- do_shift(SM_LSL,16,reg1);
- if size=OS_S16 then
- do_shift(SM_ASR,16,reg2)
- else
- do_shift(SM_LSR,16,reg2);
- end;
- else
- result:=false;
- end;
- conv_done:=result;
- end;
- var
- instr: taicpu;
- begin
- conv_done:=false;
- if tcgsize2size[tosize]<>tcgsize2size[fromsize] then
- begin
- shifterop_reset(so);
- if not do_conv(tosize) then
- if tosize in [OS_32,OS_S32] then
- do_conv(fromsize)
- else
- internalerror(2002090901);
- end;
- if not conv_done and (reg1<>reg2) then
- begin
- { same size, only a register mov required }
- instr:=taicpu.op_reg_reg(A_MOV,reg2,reg1);
- list.Concat(instr);
- { Notify the register allocator that we have written a move instruction so
- it can try to eliminate it. }
- add_move_instruction(instr);
- end;
- end;
- procedure tcgarm.a_paramfpu_ref(list : TAsmList;size : tcgsize;const ref : treference;const paraloc : TCGPara);
- var
- href,href2 : treference;
- hloc : pcgparalocation;
- begin
- href:=ref;
- hloc:=paraloc.location;
- while assigned(hloc) do
- begin
- case hloc^.loc of
- LOC_FPUREGISTER,LOC_CFPUREGISTER:
- a_loadfpu_ref_reg(list,size,size,ref,hloc^.register);
- LOC_REGISTER :
- case hloc^.size of
- OS_F32:
- a_load_ref_reg(list,OS_32,OS_32,href,hloc^.register);
- OS_64,
- OS_F64:
- cg64.a_param64_ref(list,href,paraloc);
- else
- a_load_ref_reg(list,hloc^.size,hloc^.size,href,hloc^.register);
- end;
- LOC_REFERENCE :
- begin
- reference_reset_base(href2,hloc^.reference.index,hloc^.reference.offset);
- { concatcopy should choose the best way to copy the data }
- g_concatcopy(list,href,href2,tcgsize2size[size]);
- end;
- else
- internalerror(200408241);
- end;
- inc(href.offset,tcgsize2size[hloc^.size]);
- hloc:=hloc^.next;
- end;
- end;
- procedure tcgarm.a_loadfpu_reg_reg(list: TAsmList; fromsize,tosize: tcgsize; reg1, reg2: tregister);
- begin
- list.concat(setoppostfix(taicpu.op_reg_reg(A_MVF,reg2,reg1),cgsize2fpuoppostfix[tosize]));
- end;
- procedure tcgarm.a_loadfpu_ref_reg(list: TAsmList; fromsize,tosize: tcgsize; const ref: treference; reg: tregister);
- var
- oppostfix:toppostfix;
- begin
- case tosize of
- OS_32,
- OS_F32:
- oppostfix:=PF_S;
- OS_64,
- OS_F64:
- oppostfix:=PF_D;
- OS_F80:
- oppostfix:=PF_E;
- else
- InternalError(200309021);
- end;
- handle_load_store(list,A_LDF,oppostfix,reg,ref);
- end;
- procedure tcgarm.a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference);
- var
- oppostfix:toppostfix;
- begin
- case tosize of
- OS_F32:
- oppostfix:=PF_S;
- OS_F64:
- oppostfix:=PF_D;
- OS_F80:
- oppostfix:=PF_E;
- else
- InternalError(200309022);
- end;
- handle_load_store(list,A_STF,oppostfix,reg,ref);
- end;
- { comparison operations }
- procedure tcgarm.a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : aint;reg : tregister;
- l : tasmlabel);
- var
- tmpreg : tregister;
- b : byte;
- begin
- if is_shifter_const(a,b) then
- list.concat(taicpu.op_reg_const(A_CMP,reg,a))
- { CMN reg,0 and CMN reg,$80000000 are different from CMP reg,$ffffffff
- and CMP reg,$7fffffff regarding the flags according to the ARM manual }
- else if (a<>$7fffffff) and (a<>-1) and is_shifter_const(-a,b) then
- list.concat(taicpu.op_reg_const(A_CMN,reg,-a))
- else
- begin
- tmpreg:=getintregister(list,size);
- a_load_const_reg(list,size,a,tmpreg);
- list.concat(taicpu.op_reg_reg(A_CMP,reg,tmpreg));
- end;
- a_jmp_cond(list,cmp_op,l);
- end;
- procedure tcgarm.a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel);
- begin
- list.concat(taicpu.op_reg_reg(A_CMP,reg2,reg1));
- a_jmp_cond(list,cmp_op,l);
- end;
- procedure tcgarm.a_jmp_name(list : TAsmList;const s : string);
- var
- ai : taicpu;
- begin
- ai:=taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol(s));
- ai.is_jmp:=true;
- list.concat(ai);
- end;
- procedure tcgarm.a_jmp_always(list : TAsmList;l: tasmlabel);
- var
- ai : taicpu;
- begin
- ai:=taicpu.op_sym(A_B,l);
- ai.is_jmp:=true;
- list.concat(ai);
- end;
- procedure tcgarm.a_jmp_flags(list : TAsmList;const f : TResFlags;l: tasmlabel);
- var
- ai : taicpu;
- begin
- ai:=setcondition(taicpu.op_sym(A_B,l),flags_to_cond(f));
- ai.is_jmp:=true;
- list.concat(ai);
- end;
- procedure tcgarm.g_flags2reg(list: TAsmList; size: TCgSize; const f: TResFlags; reg: TRegister);
- begin
- list.concat(setcondition(taicpu.op_reg_const(A_MOV,reg,1),flags_to_cond(f)));
- list.concat(setcondition(taicpu.op_reg_const(A_MOV,reg,0),inverse_cond(flags_to_cond(f))));
- end;
- procedure tcgarm.g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean);
- var
- ref : treference;
- shift : byte;
- firstfloatreg,lastfloatreg,
- r : byte;
- regs : tcpuregisterset;
- begin
- LocalSize:=align(LocalSize,4);
- if not(nostackframe) then
- begin
- firstfloatreg:=RS_NO;
- { save floating point registers? }
- for r:=RS_F0 to RS_F7 do
- if r in rg[R_FPUREGISTER].used_in_proc-paramanager.get_volatile_registers_fpu(pocall_stdcall) then
- begin
- if firstfloatreg=RS_NO then
- firstfloatreg:=r;
- lastfloatreg:=r;
- end;
- a_reg_alloc(list,NR_STACK_POINTER_REG);
- if current_procinfo.framepointer<>NR_STACK_POINTER_REG then
- begin
- a_reg_alloc(list,NR_FRAME_POINTER_REG);
- a_reg_alloc(list,NR_R12);
- list.concat(taicpu.op_reg_reg(A_MOV,NR_R12,NR_STACK_POINTER_REG));
- end;
- { save int registers }
- reference_reset(ref);
- ref.index:=NR_STACK_POINTER_REG;
- ref.addressmode:=AM_PREINDEXED;
- regs:=rg[R_INTREGISTER].used_in_proc-paramanager.get_volatile_registers_int(pocall_stdcall);
- if current_procinfo.framepointer<>NR_STACK_POINTER_REG then
- regs:=regs+[RS_R11,RS_R12,RS_R14,RS_R15]
- else
- if (regs<>[]) or (pi_do_call in current_procinfo.flags) then
- include(regs,RS_R14);
- if regs<>[] then
- list.concat(setoppostfix(taicpu.op_ref_regset(A_STM,ref,regs),PF_FD));
- if current_procinfo.framepointer<>NR_STACK_POINTER_REG then
- list.concat(taicpu.op_reg_reg_const(A_SUB,NR_FRAME_POINTER_REG,NR_R12,4));
- { allocate necessary stack size
- not necessary according to Yury Sidorov
- { don't use a_op_const_reg_reg here because we don't allow register allocations
- in the entry/exit code }
- if (target_info.system in [system_arm_wince]) and
- (localsize>=winstackpagesize) then
- begin
- if localsize div winstackpagesize<=5 then
- begin
- if is_shifter_const(localsize,shift) then
- list.concat(Taicpu.op_reg_reg_const(A_SUB,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,localsize))
- else
- begin
- a_load_const_reg(list,OS_ADDR,localsize,NR_R12);
- list.concat(taicpu.op_reg_reg_reg(A_SUB,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,NR_R12));
- end;
- for i:=1 to localsize div winstackpagesize do
- begin
- if localsize-i*winstackpagesize<4096 then
- reference_reset_base(href,NR_STACK_POINTER_REG,-(localsize-i*winstackpagesize))
- else
- begin
- a_load_const_reg(list,OS_ADDR,-(localsize-i*winstackpagesize),NR_R12);
- reference_reset_base(href,NR_STACK_POINTER_REG,0);
- href.index:=NR_R12;
- end;
- { the data stored doesn't matter }
- list.concat(Taicpu.op_reg_ref(A_STR,NR_R0,href));
- end;
- a_reg_dealloc(list,NR_R12);
- reference_reset_base(href,NR_STACK_POINTER_REG,0);
- { the data stored doesn't matter }
- list.concat(Taicpu.op_reg_ref(A_STR,NR_R0,href));
- end
- else
- begin
- current_asmdata.getjumplabel(again);
- list.concat(Taicpu.op_reg_const(A_MOV,NR_R12,localsize div winstackpagesize));
- a_label(list,again);
- { always shifterop }
- list.concat(Taicpu.op_reg_reg_const(A_SUB,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,winstackpagesize));
- reference_reset_base(href,NR_STACK_POINTER_REG,0);
- { the data stored doesn't matter }
- list.concat(Taicpu.op_reg_ref(A_STR,NR_R0,href));
- list.concat(Taicpu.op_reg_reg_const(A_SUB,NR_R12,NR_R12,1));
- a_jmp_cond(list,OC_NE,again);
- if is_shifter_const(localsize mod winstackpagesize,shift) then
- list.concat(Taicpu.op_reg_reg_const(A_SUB,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,localsize mod winstackpagesize))
- else
- begin
- a_load_const_reg(list,OS_ADDR,localsize mod winstackpagesize,NR_R12);
- list.concat(taicpu.op_reg_reg_reg(A_SUB,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,NR_R12));
- end;
- a_reg_dealloc(list,NR_R12);
- reference_reset_base(href,NR_STACK_POINTER_REG,0);
- { the data stored doesn't matter }
- list.concat(Taicpu.op_reg_ref(A_STR,NR_R0,href));
- end
- end
- else
- }
- if LocalSize<>0 then
- if not(is_shifter_const(localsize,shift)) then
- begin
- if current_procinfo.framepointer=NR_STACK_POINTER_REG then
- a_reg_alloc(list,NR_R12);
- a_load_const_reg(list,OS_ADDR,LocalSize,NR_R12);
- list.concat(taicpu.op_reg_reg_reg(A_SUB,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,NR_R12));
- a_reg_dealloc(list,NR_R12);
- end
- else
- begin
- a_reg_dealloc(list,NR_R12);
- list.concat(taicpu.op_reg_reg_const(A_SUB,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,LocalSize));
- end;
- if firstfloatreg<>RS_NO then
- begin
- reference_reset(ref);
- if tg.direction*tarmprocinfo(current_procinfo).floatregstart>=1023 then
- begin
- a_load_const_reg(list,OS_ADDR,-tarmprocinfo(current_procinfo).floatregstart,NR_R12);
- list.concat(taicpu.op_reg_reg_reg(A_SUB,NR_R12,current_procinfo.framepointer,NR_R12));
- ref.base:=NR_R12;
- end
- else
- begin
- ref.base:=current_procinfo.framepointer;
- ref.offset:=tarmprocinfo(current_procinfo).floatregstart;
- end;
- list.concat(taicpu.op_reg_const_ref(A_SFM,newreg(R_FPUREGISTER,firstfloatreg,R_SUBWHOLE),
- lastfloatreg-firstfloatreg+1,ref));
- end;
- end;
- end;
- procedure tcgarm.g_proc_exit(list : TAsmList;parasize : longint;nostackframe:boolean);
- var
- ref : treference;
- firstfloatreg,lastfloatreg,
- r : byte;
- shift : byte;
- regs : tcpuregisterset;
- LocalSize : longint;
- begin
- if not(nostackframe) then
- begin
- { restore floating point register }
- firstfloatreg:=RS_NO;
- { save floating point registers? }
- for r:=RS_F0 to RS_F7 do
- if r in rg[R_FPUREGISTER].used_in_proc-paramanager.get_volatile_registers_fpu(pocall_stdcall) then
- begin
- if firstfloatreg=RS_NO then
- firstfloatreg:=r;
- lastfloatreg:=r;
- end;
- if firstfloatreg<>RS_NO then
- begin
- reference_reset(ref);
- if tg.direction*tarmprocinfo(current_procinfo).floatregstart>=1023 then
- begin
- a_load_const_reg(list,OS_ADDR,-tarmprocinfo(current_procinfo).floatregstart,NR_R12);
- list.concat(taicpu.op_reg_reg_reg(A_SUB,NR_R12,current_procinfo.framepointer,NR_R12));
- ref.base:=NR_R12;
- end
- else
- begin
- ref.base:=current_procinfo.framepointer;
- ref.offset:=tarmprocinfo(current_procinfo).floatregstart;
- end;
- list.concat(taicpu.op_reg_const_ref(A_LFM,newreg(R_FPUREGISTER,firstfloatreg,R_SUBWHOLE),
- lastfloatreg-firstfloatreg+1,ref));
- end;
- if (current_procinfo.framepointer=NR_STACK_POINTER_REG) then
- begin
- LocalSize:=current_procinfo.calc_stackframe_size;
- if LocalSize<>0 then
- if not(is_shifter_const(LocalSize,shift)) then
- begin
- a_reg_alloc(list,NR_R12);
- a_load_const_reg(list,OS_ADDR,LocalSize,NR_R12);
- list.concat(taicpu.op_reg_reg_reg(A_ADD,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,NR_R12));
- a_reg_dealloc(list,NR_R12);
- end
- else
- begin
- list.concat(taicpu.op_reg_reg_const(A_ADD,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,LocalSize));
- end;
- regs:=rg[R_INTREGISTER].used_in_proc-paramanager.get_volatile_registers_int(pocall_stdcall);
- if (pi_do_call in current_procinfo.flags) or (regs<>[]) then
- begin
- exclude(regs,RS_R14);
- include(regs,RS_R15);
- end;
- if regs=[] then
- list.concat(taicpu.op_reg_reg(A_MOV,NR_R15,NR_R14))
- else
- begin
- reference_reset(ref);
- ref.index:=NR_STACK_POINTER_REG;
- ref.addressmode:=AM_PREINDEXED;
- list.concat(setoppostfix(taicpu.op_ref_regset(A_LDM,ref,regs),PF_FD));
- end;
- end
- else
- begin
- { restore int registers and return }
- reference_reset(ref);
- ref.index:=NR_FRAME_POINTER_REG;
- list.concat(setoppostfix(taicpu.op_ref_regset(A_LDM,ref,rg[R_INTREGISTER].used_in_proc-paramanager.get_volatile_registers_int(pocall_stdcall)+[RS_R11,RS_R13,RS_R15]),PF_EA));
- end;
- end
- else
- list.concat(taicpu.op_reg_reg(A_MOV,NR_PC,NR_R14));
- end;
- procedure tcgarm.a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);
- var
- b : byte;
- tmpref : treference;
- instr : taicpu;
- begin
- if ref.addressmode<>AM_OFFSET then
- internalerror(200309071);
- tmpref:=ref;
- { Be sure to have a base register }
- if (tmpref.base=NR_NO) then
- begin
- if tmpref.shiftmode<>SM_None then
- internalerror(200308294);
- if tmpref.signindex<0 then
- internalerror(200312023);
- tmpref.base:=tmpref.index;
- tmpref.index:=NR_NO;
- end;
- if assigned(tmpref.symbol) or
- not((is_shifter_const(tmpref.offset,b)) or
- (is_shifter_const(-tmpref.offset,b))
- ) then
- fixref(list,tmpref);
- { expect a base here if there is an index }
- if (tmpref.base=NR_NO) and (tmpref.index<>NR_NO) then
- internalerror(200312022);
- if tmpref.index<>NR_NO then
- begin
- if tmpref.shiftmode<>SM_None then
- internalerror(200312021);
- if tmpref.signindex<0 then
- a_op_reg_reg_reg(list,OP_SUB,OS_ADDR,tmpref.base,tmpref.index,r)
- else
- a_op_reg_reg_reg(list,OP_ADD,OS_ADDR,tmpref.base,tmpref.index,r);
- if tmpref.offset<>0 then
- a_op_const_reg_reg(list,OP_ADD,OS_ADDR,tmpref.offset,r,r);
- end
- else
- begin
- if tmpref.base=NR_NO then
- a_load_const_reg(list,OS_ADDR,tmpref.offset,r)
- else
- if tmpref.offset<>0 then
- a_op_const_reg_reg(list,OP_ADD,OS_ADDR,tmpref.offset,tmpref.base,r)
- else
- begin
- instr:=taicpu.op_reg_reg(A_MOV,r,tmpref.base);
- list.concat(instr);
- add_move_instruction(instr);
- end;
- end;
- end;
- procedure tcgarm.fixref(list : TAsmList;var ref : treference);
- var
- tmpreg : tregister;
- tmpref : treference;
- l : tasmlabel;
- begin
- { absolute symbols can't be handled directly, we've to store the symbol reference
- in the text segment and access it pc relative
- For now, we assume that references where base or index equals to PC are already
- relative, all other references are assumed to be absolute and thus they need
- to be handled extra.
- A proper solution would be to change refoptions to a set and store the information
- if the symbol is absolute or relative there.
- }
- { create consts entry }
- reference_reset(tmpref);
- current_asmdata.getjumplabel(l);
- cg.a_label(current_procinfo.aktlocaldata,l);
- tmpref.symboldata:=current_procinfo.aktlocaldata.last;
- if assigned(ref.symbol) then
- current_procinfo.aktlocaldata.concat(tai_const.create_sym_offset(ref.symbol,ref.offset))
- else
- current_procinfo.aktlocaldata.concat(tai_const.Create_32bit(ref.offset));
- { load consts entry }
- tmpreg:=getintregister(list,OS_INT);
- tmpref.symbol:=l;
- tmpref.base:=NR_PC;
- list.concat(taicpu.op_reg_ref(A_LDR,tmpreg,tmpref));
- if (ref.base<>NR_NO) then
- begin
- if ref.index<>NR_NO then
- begin
- list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.base,tmpreg));
- ref.base:=tmpreg;
- end
- else
- if ref.base<>NR_PC then
- begin
- ref.index:=tmpreg;
- ref.shiftimm:=0;
- ref.signindex:=1;
- ref.shiftmode:=SM_None;
- end
- else
- ref.base:=tmpreg;
- end
- else
- ref.base:=tmpreg;
- ref.offset:=0;
- ref.symbol:=nil;
- end;
- procedure tcgarm.g_concatcopy_move(list : TAsmList;const source,dest : treference;len : aint);
- var
- paraloc1,paraloc2,paraloc3 : TCGPara;
- begin
- paraloc1.init;
- paraloc2.init;
- paraloc3.init;
- paramanager.getintparaloc(pocall_default,1,paraloc1);
- paramanager.getintparaloc(pocall_default,2,paraloc2);
- paramanager.getintparaloc(pocall_default,3,paraloc3);
- paramanager.allocparaloc(list,paraloc3);
- a_param_const(list,OS_INT,len,paraloc3);
- paramanager.allocparaloc(list,paraloc2);
- a_paramaddr_ref(list,dest,paraloc2);
- paramanager.allocparaloc(list,paraloc2);
- a_paramaddr_ref(list,source,paraloc1);
- paramanager.freeparaloc(list,paraloc3);
- paramanager.freeparaloc(list,paraloc2);
- paramanager.freeparaloc(list,paraloc1);
- alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
- alloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
- a_call_name(list,'FPC_MOVE');
- dealloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
- dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
- paraloc3.done;
- paraloc2.done;
- paraloc1.done;
- end;
- procedure tcgarm.g_concatcopy_internal(list : TAsmList;const source,dest : treference;len : aint;aligned : boolean);
- const
- maxtmpreg=10;{roozbeh: can be reduced to 8 or lower if might conflick with reserved ones,also +2 is used becouse of regs required for referencing}
- var
- srcref,dstref,usedtmpref,usedtmpref2:treference;
- srcreg,destreg,countreg,r,tmpreg:tregister;
- helpsize:aint;
- copysize:byte;
- cgsize:Tcgsize;
- tmpregisters:array[1..maxtmpreg] of tregister;
- tmpregi,tmpregi2:byte;
- { will never be called with count<=4 }
- procedure genloop(count : aword;size : byte);
- const
- size2opsize : array[1..4] of tcgsize = (OS_8,OS_16,OS_NO,OS_32);
- var
- l : tasmlabel;
- begin
- current_asmdata.getjumplabel(l);
- if count<size then size:=1;
- a_load_const_reg(list,OS_INT,count div size,countreg);
- cg.a_label(list,l);
- srcref.addressmode:=AM_POSTINDEXED;
- dstref.addressmode:=AM_POSTINDEXED;
- srcref.offset:=size;
- dstref.offset:=size;
- r:=getintregister(list,size2opsize[size]);
- a_load_ref_reg(list,size2opsize[size],size2opsize[size],srcref,r);
- list.concat(setoppostfix(taicpu.op_reg_reg_const(A_SUB,countreg,countreg,1),PF_S));
- a_load_reg_ref(list,size2opsize[size],size2opsize[size],r,dstref);
- a_jmp_flags(list,F_NE,l);
- srcref.offset:=1;
- dstref.offset:=1;
- case count mod size of
- 1:
- begin
- a_load_ref_reg(list,OS_8,OS_8,srcref,r);
- a_load_reg_ref(list,OS_8,OS_8,r,dstref);
- end;
- 2:
- if aligned then
- begin
- a_load_ref_reg(list,OS_16,OS_16,srcref,r);
- a_load_reg_ref(list,OS_16,OS_16,r,dstref);
- end
- else
- begin
- a_load_ref_reg(list,OS_8,OS_8,srcref,r);
- a_load_reg_ref(list,OS_8,OS_8,r,dstref);
- a_load_ref_reg(list,OS_8,OS_8,srcref,r);
- a_load_reg_ref(list,OS_8,OS_8,r,dstref);
- end;
- 3:
- if aligned then
- begin
- srcref.offset:=2;
- dstref.offset:=2;
- a_load_ref_reg(list,OS_16,OS_16,srcref,r);
- a_load_reg_ref(list,OS_16,OS_16,r,dstref);
- a_load_ref_reg(list,OS_8,OS_8,srcref,r);
- a_load_reg_ref(list,OS_8,OS_8,r,dstref);
- end
- else
- begin
- a_load_ref_reg(list,OS_8,OS_8,srcref,r);
- a_load_reg_ref(list,OS_8,OS_8,r,dstref);
- a_load_ref_reg(list,OS_8,OS_8,srcref,r);
- a_load_reg_ref(list,OS_8,OS_8,r,dstref);
- a_load_ref_reg(list,OS_8,OS_8,srcref,r);
- a_load_reg_ref(list,OS_8,OS_8,r,dstref);
- end;
- end;
- { keep the registers alive }
- list.concat(taicpu.op_reg_reg(A_MOV,countreg,countreg));
- list.concat(taicpu.op_reg_reg(A_MOV,srcreg,srcreg));
- list.concat(taicpu.op_reg_reg(A_MOV,destreg,destreg));
- end;
- begin
- if len=0 then
- exit;
- helpsize:=12+maxtmpreg*4;//52 with maxtmpreg=10
- dstref:=dest;
- srcref:=source;
- if cs_opt_size in current_settings.optimizerswitches then
- helpsize:=8;
- if (len<=helpsize) and aligned then
- begin
- tmpregi:=0;
- srcreg:=getintregister(list,OS_ADDR);
- { explicit pc relative addressing, could be
- e.g. a floating point constant }
- if source.base=NR_PC then
- begin
- { ... then we don't need a loadaddr }
- srcref:=source;
- end
- else
- begin
- a_loadaddr_ref_reg(list,source,srcreg);
- reference_reset_base(srcref,srcreg,0);
- end;
- while (len div 4 <> 0) and (tmpregi<maxtmpreg) do
- begin
- inc(tmpregi);
- tmpregisters[tmpregi]:=getintregister(list,OS_32);
- a_load_ref_reg(list,OS_32,OS_32,srcref,tmpregisters[tmpregi]);
- inc(srcref.offset,4);
- dec(len,4);
- end;
- destreg:=getintregister(list,OS_ADDR);
- a_loadaddr_ref_reg(list,dest,destreg);
- reference_reset_base(dstref,destreg,0);
- tmpregi2:=1;
- while (tmpregi2<=tmpregi) do
- begin
- a_load_reg_ref(list,OS_32,OS_32,tmpregisters[tmpregi2],dstref);
- inc(dstref.offset,4);
- inc(tmpregi2);
- end;
- copysize:=4;
- cgsize:=OS_32;
- while len<>0 do
- begin
- if len<2 then
- begin
- copysize:=1;
- cgsize:=OS_8;
- end
- else if len<4 then
- begin
- copysize:=2;
- cgsize:=OS_16;
- end;
- dec(len,copysize);
- r:=getintregister(list,cgsize);
- a_load_ref_reg(list,cgsize,cgsize,srcref,r);
- a_load_reg_ref(list,cgsize,cgsize,r,dstref);
- inc(srcref.offset,copysize);
- inc(dstref.offset,copysize);
- end;{end of while}
- end
- else
- begin
- cgsize:=OS_32;
- if (len<=4) then{len<=4 and not aligned}
- begin
- r:=getintregister(list,cgsize);
- usedtmpref:=a_internal_load_ref_reg(list,OS_8,OS_8,srcref,r);
- if Len=1 then
- a_load_reg_ref(list,OS_8,OS_8,r,dstref)
- else
- begin
- tmpreg:=getintregister(list,cgsize);
- usedtmpref2:=a_internal_load_reg_ref(list,OS_8,OS_8,r,dstref);
- inc(usedtmpref.offset,1);
- a_load_ref_reg(list,OS_8,OS_8,usedtmpref,tmpreg);
- inc(usedtmpref2.offset,1);
- a_load_reg_ref(list,OS_8,OS_8,tmpreg,usedtmpref2);
- if len>2 then
- begin
- inc(usedtmpref.offset,1);
- a_load_ref_reg(list,OS_8,OS_8,usedtmpref,tmpreg);
- inc(usedtmpref2.offset,1);
- a_load_reg_ref(list,OS_8,OS_8,tmpreg,usedtmpref2);
- if len>3 then
- begin
- inc(usedtmpref.offset,1);
- a_load_ref_reg(list,OS_8,OS_8,usedtmpref,tmpreg);
- inc(usedtmpref2.offset,1);
- a_load_reg_ref(list,OS_8,OS_8,tmpreg,usedtmpref2);
- end;
- end;
- end;
- end{end of if len<=4}
- else
- begin{unaligned & 4<len<helpsize **or** aligned/unaligned & len>helpsize}
- destreg:=getintregister(list,OS_ADDR);
- a_loadaddr_ref_reg(list,dest,destreg);
- reference_reset_base(dstref,destreg,0);
- srcreg:=getintregister(list,OS_ADDR);
- a_loadaddr_ref_reg(list,source,srcreg);
- reference_reset_base(srcref,srcreg,0);
- countreg:=getintregister(list,OS_32);
- // if cs_opt_size in current_settings.optimizerswitches then
- { roozbeh : it seems loading 1 byte is faster becouse of caching/fetching(?) }
- {if aligned then
- genloop(len,4)
- else}
- genloop(len,1);
- end;
- end;
- end;
- procedure tcgarm.g_concatcopy_unaligned(list : TAsmList;const source,dest : treference;len : aint);
- begin
- g_concatcopy_internal(list,source,dest,len,false);
- end;
- procedure tcgarm.g_concatcopy(list : TAsmList;const source,dest : treference;len : aint);
- begin
- if (source.alignment in [1..3]) or
- (dest.alignment in [1..3]) then
- g_concatcopy_internal(list,source,dest,len,false)
- else
- g_concatcopy_internal(list,source,dest,len,true);
- end;
- procedure tcgarm.g_overflowCheck(list : TAsmList;const l : tlocation;def : tdef);
- var
- ovloc : tlocation;
- begin
- ovloc.loc:=LOC_VOID;
- g_overflowCheck_loc(list,l,def,ovloc);
- end;
- procedure tcgarm.g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;ovloc : tlocation);
- var
- hl : tasmlabel;
- ai:TAiCpu;
- hflags : tresflags;
- begin
- if not(cs_check_overflow in current_settings.localswitches) then
- exit;
- current_asmdata.getjumplabel(hl);
- case ovloc.loc of
- LOC_VOID:
- begin
- ai:=taicpu.op_sym(A_B,hl);
- ai.is_jmp:=true;
- if not((def.typ=pointerdef) or
- ((def.typ=orddef) and
- (torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,bool8bit,bool16bit,bool32bit]))) then
- ai.SetCondition(C_VC)
- else
- if TAiCpu(List.Last).opcode in [A_RSB,A_RSC,A_SBC,A_SUB] then
- ai.SetCondition(C_CS)
- else
- ai.SetCondition(C_CC);
- list.concat(ai);
- end;
- LOC_FLAGS:
- begin
- hflags:=ovloc.resflags;
- inverse_flags(hflags);
- cg.a_jmp_flags(list,hflags,hl);
- end;
- else
- internalerror(200409281);
- end;
- a_call_name(list,'FPC_OVERFLOW');
- a_label(list,hl);
- end;
- procedure tcgarm.g_save_standard_registers(list : TAsmList);
- begin
- { this work is done in g_proc_entry }
- end;
- procedure tcgarm.g_restore_standard_registers(list : TAsmList);
- begin
- { this work is done in g_proc_exit }
- end;
- procedure tcgarm.a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel);
- var
- ai : taicpu;
- begin
- ai:=Taicpu.Op_sym(A_B,l);
- ai.SetCondition(OpCmp2AsmCond[cond]);
- ai.is_jmp:=true;
- list.concat(ai);
- end;
- procedure tcgarm.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
- procedure loadvmttor12;
- var
- href : treference;
- begin
- reference_reset_base(href,NR_R0,0);
- cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R12);
- end;
- procedure op_onr12methodaddr;
- var
- href : treference;
- begin
- if (procdef.extnumber=$ffff) then
- Internalerror(200006139);
- { call/jmp vmtoffs(%eax) ; method offs }
- reference_reset_base(href,NR_R12,procdef._class.vmtmethodoffset(procdef.extnumber));
- cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R12);
- list.concat(taicpu.op_reg_reg(A_MOV,NR_PC,NR_R12));
- end;
- var
- make_global : boolean;
- begin
- if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
- Internalerror(200006137);
- if not assigned(procdef._class) or
- (procdef.procoptions*[po_classmethod, po_staticmethod,
- po_methodpointer, po_interrupt, po_iocheck]<>[]) then
- Internalerror(200006138);
- if procdef.owner.symtabletype<>ObjectSymtable then
- Internalerror(200109191);
- make_global:=false;
- if (not current_module.is_unit) or
- (cs_create_smart in current_settings.moduleswitches) or
- (procdef.owner.defowner.owner.symtabletype=globalsymtable) then
- make_global:=true;
- if make_global then
- list.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0))
- else
- list.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0));
- { set param1 interface to self }
- g_adjust_self_value(list,procdef,ioffset);
- { case 4 }
- if po_virtualmethod in procdef.procoptions then
- begin
- loadvmttor12;
- op_onr12methodaddr;
- end
- { case 0 }
- else
- list.concat(taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol(procdef.mangledname)));
- list.concat(Tai_symbol_end.Createname(labelname));
- end;
- procedure tcg64farm.a_op64_reg_reg(list : TAsmList;op:TOpCG;size : tcgsize;regsrc,regdst : tregister64);
- begin
- case op of
- OP_NEG:
- begin
- list.concat(setoppostfix(taicpu.op_reg_reg_const(A_RSB,regdst.reglo,regsrc.reglo,0),PF_S));
- list.concat(taicpu.op_reg_reg_const(A_RSC,regdst.reghi,regsrc.reghi,0));
- end;
- OP_NOT:
- begin
- cg.a_op_reg_reg(list,OP_NOT,OS_INT,regsrc.reglo,regdst.reglo);
- cg.a_op_reg_reg(list,OP_NOT,OS_INT,regsrc.reghi,regdst.reghi);
- end;
- else
- a_op64_reg_reg_reg(list,op,size,regsrc,regdst,regdst);
- end;
- end;
- procedure tcg64farm.a_op64_const_reg(list : TAsmList;op:TOpCG;size : tcgsize;value : int64;reg : tregister64);
- begin
- a_op64_const_reg_reg(list,op,size,value,reg,reg);
- end;
- procedure tcg64farm.a_op64_const_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64);
- var
- ovloc : tlocation;
- begin
- a_op64_const_reg_reg_checkoverflow(list,op,size,value,regsrc,regdst,false,ovloc);
- end;
- procedure tcg64farm.a_op64_reg_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64);
- var
- ovloc : tlocation;
- begin
- a_op64_reg_reg_reg_checkoverflow(list,op,size,regsrc1,regsrc2,regdst,false,ovloc);
- end;
- procedure tcg64farm.a_op64_const_reg_reg_checkoverflow(list: TAsmList;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64;setflags : boolean;var ovloc : tlocation);
- var
- tmpreg : tregister;
- b : byte;
- begin
- ovloc.loc:=LOC_VOID;
- case op of
- OP_NEG,
- OP_NOT :
- internalerror(200306017);
- end;
- if (setflags or tcgarm(cg).cgsetflags) and (op in [OP_ADD,OP_SUB]) then
- begin
- case op of
- OP_ADD:
- begin
- if is_shifter_const(lo(value),b) then
- list.concat(setoppostfix(taicpu.op_reg_reg_const(A_ADD,regdst.reglo,regsrc.reglo,lo(value)),PF_S))
- else
- begin
- tmpreg:=cg.getintregister(list,OS_32);
- cg.a_load_const_reg(list,OS_32,lo(value),tmpreg);
- list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ADD,regdst.reglo,regsrc.reglo,tmpreg),PF_S));
- end;
- if is_shifter_const(hi(value),b) then
- list.concat(setoppostfix(taicpu.op_reg_reg_const(A_ADC,regdst.reghi,regsrc.reghi,hi(value)),PF_S))
- else
- begin
- tmpreg:=cg.getintregister(list,OS_32);
- cg.a_load_const_reg(list,OS_32,hi(value),tmpreg);
- list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ADC,regdst.reghi,regsrc.reghi,tmpreg),PF_S));
- end;
- end;
- OP_SUB:
- begin
- if is_shifter_const(lo(value),b) then
- list.concat(setoppostfix(taicpu.op_reg_reg_const(A_SUB,regdst.reglo,regsrc.reglo,lo(value)),PF_S))
- else
- begin
- tmpreg:=cg.getintregister(list,OS_32);
- cg.a_load_const_reg(list,OS_32,lo(value),tmpreg);
- list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_SUB,regdst.reglo,regsrc.reglo,tmpreg),PF_S));
- end;
- if is_shifter_const(hi(value),b) then
- list.concat(setoppostfix(taicpu.op_reg_reg_const(A_SBC,regdst.reghi,regsrc.reghi,aint(hi(value))),PF_S))
- else
- begin
- tmpreg:=cg.getintregister(list,OS_32);
- cg.a_load_const_reg(list,OS_32,hi(value),tmpreg);
- list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_SBC,regdst.reghi,regsrc.reghi,tmpreg),PF_S));
- end;
- end;
- else
- internalerror(200502131);
- end;
- if size=OS_64 then
- begin
- { the arm has an weired opinion how flags for SUB/ADD are handled }
- ovloc.loc:=LOC_FLAGS;
- case op of
- OP_ADD:
- ovloc.resflags:=F_CS;
- OP_SUB:
- ovloc.resflags:=F_CC;
- end;
- end;
- end
- else
- begin
- case op of
- OP_AND,OP_OR,OP_XOR:
- begin
- cg.a_op_const_reg_reg(list,op,OS_32,aint(lo(value)),regsrc.reglo,regdst.reglo);
- cg.a_op_const_reg_reg(list,op,OS_32,aint(hi(value)),regsrc.reghi,regdst.reghi);
- end;
- OP_ADD:
- begin
- if is_shifter_const(aint(lo(value)),b) then
- list.concat(setoppostfix(taicpu.op_reg_reg_const(A_ADD,regdst.reglo,regsrc.reglo,aint(lo(value))),PF_S))
- else
- begin
- tmpreg:=cg.getintregister(list,OS_32);
- cg.a_load_const_reg(list,OS_32,aint(lo(value)),tmpreg);
- list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ADD,regdst.reglo,regsrc.reglo,tmpreg),PF_S));
- end;
- if is_shifter_const(aint(hi(value)),b) then
- list.concat(taicpu.op_reg_reg_const(A_ADC,regdst.reghi,regsrc.reghi,aint(hi(value))))
- else
- begin
- tmpreg:=cg.getintregister(list,OS_32);
- cg.a_load_const_reg(list,OS_32,aint(hi(value)),tmpreg);
- list.concat(taicpu.op_reg_reg_reg(A_ADC,regdst.reghi,regsrc.reghi,tmpreg));
- end;
- end;
- OP_SUB:
- begin
- if is_shifter_const(aint(lo(value)),b) then
- list.concat(setoppostfix(taicpu.op_reg_reg_const(A_SUB,regdst.reglo,regsrc.reglo,aint(lo(value))),PF_S))
- else
- begin
- tmpreg:=cg.getintregister(list,OS_32);
- cg.a_load_const_reg(list,OS_32,aint(lo(value)),tmpreg);
- list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_SUB,regdst.reglo,regsrc.reglo,tmpreg),PF_S));
- end;
- if is_shifter_const(aint(hi(value)),b) then
- list.concat(taicpu.op_reg_reg_const(A_SBC,regdst.reghi,regsrc.reghi,aint(hi(value))))
- else
- begin
- tmpreg:=cg.getintregister(list,OS_32);
- cg.a_load_const_reg(list,OS_32,hi(value),tmpreg);
- list.concat(taicpu.op_reg_reg_reg(A_SBC,regdst.reghi,regsrc.reghi,tmpreg));
- end;
- end;
- else
- internalerror(2003083101);
- end;
- end;
- end;
- procedure tcg64farm.a_op64_reg_reg_reg_checkoverflow(list: TAsmList;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64;setflags : boolean;var ovloc : tlocation);
- begin
- ovloc.loc:=LOC_VOID;
- case op of
- OP_NEG,
- OP_NOT :
- internalerror(200306017);
- end;
- if (setflags or tcgarm(cg).cgsetflags) and (op in [OP_ADD,OP_SUB]) then
- begin
- case op of
- OP_ADD:
- begin
- list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ADD,regdst.reglo,regsrc1.reglo,regsrc2.reglo),PF_S));
- list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ADC,regdst.reghi,regsrc1.reghi,regsrc2.reghi),PF_S));
- end;
- OP_SUB:
- begin
- list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_SUB,regdst.reglo,regsrc2.reglo,regsrc1.reglo),PF_S));
- list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_SBC,regdst.reghi,regsrc2.reghi,regsrc1.reghi),PF_S));
- end;
- else
- internalerror(2003083101);
- end;
- if size=OS_64 then
- begin
- { the arm has an weired opinion how flags for SUB/ADD are handled }
- ovloc.loc:=LOC_FLAGS;
- case op of
- OP_ADD:
- ovloc.resflags:=F_CS;
- OP_SUB:
- ovloc.resflags:=F_CC;
- end;
- end;
- end
- else
- begin
- case op of
- OP_AND,OP_OR,OP_XOR:
- begin
- cg.a_op_reg_reg_reg(list,op,OS_32,regsrc1.reglo,regsrc2.reglo,regdst.reglo);
- cg.a_op_reg_reg_reg(list,op,OS_32,regsrc1.reghi,regsrc2.reghi,regdst.reghi);
- end;
- OP_ADD:
- begin
- list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ADD,regdst.reglo,regsrc1.reglo,regsrc2.reglo),PF_S));
- list.concat(taicpu.op_reg_reg_reg(A_ADC,regdst.reghi,regsrc1.reghi,regsrc2.reghi));
- end;
- OP_SUB:
- begin
- list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_SUB,regdst.reglo,regsrc2.reglo,regsrc1.reglo),PF_S));
- list.concat(taicpu.op_reg_reg_reg(A_SBC,regdst.reghi,regsrc2.reghi,regsrc1.reghi));
- end;
- else
- internalerror(2003083101);
- end;
- end;
- end;
- begin
- cg:=tcgarm.create;
- cg64:=tcg64farm.create;
- end.
|