1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488 |
- {
- Copyright (c) 2008 by Florian Klaempfl
- Member of the Free Pascal development team
- This unit implements the code generator for the Z80
- 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
- tregisterlist = array of tregister;
- { tcgz80 }
- tcgz80 = 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 getcpuregisters(list:TAsmList;regs:tregisterlist);
- procedure ungetcpuregisters(list:TAsmList;regs:tregisterlist);
- function getaddressregister(list:TAsmList):TRegister;override;
- function GetOffsetReg(const r: TRegister;ofs : shortint): TRegister;override;
- function GetOffsetReg64(const r,rhi: TRegister;ofs : shortint): TRegister;override;
- procedure a_load_const_cgpara(list : TAsmList;size : tcgsize;a : tcgint;const paraloc : TCGPara);override;
- procedure a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const cgpara : TCGPara);override;
- procedure a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const paraloc : TCGPara);override;
- procedure a_load_reg_cgpara(list : TAsmList; size : tcgsize;r : tregister; const cgpara : tcgpara);override;
- procedure a_loadfpu_ref_cgpara(list : TAsmList;size : tcgsize;const ref : treference;const cgpara : TCGPara);override;
- procedure a_call_name(list : TAsmList;const s : string; weak: boolean);override;
- procedure a_call_reg(list : TAsmList;reg: tregister);override;
- procedure a_op_const_reg(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; reg: TRegister); override;
- procedure a_op_reg_reg(list: TAsmList; Op: TOpCG; size: TCGSize; src, dst : TRegister); override;
- { move instructions }
- procedure a_load_const_reg(list : TAsmList; size: tcgsize; a : tcgint;reg : tregister);override;
- procedure a_load_const_ref(list : TAsmList;size : tcgsize;a : tcgint;const ref : treference);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;
- { 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;
- { comparison operations }
- procedure a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;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;
- { Z80-specific unsigned comparison code generation jmp helper }
- procedure a_jmp_unsigned_cmp_3way(list : TAsmList;onbelow,onequal,onabove: tasmlabel);
- { Z80-specific signed comparison code generation jmp helper. Should follow a SUB instruction,
- and the A register must still contain the result. }
- procedure a_jmp_signed_cmp_3way(list : TAsmList;onless,onequal,ongreater: tasmlabel);
- procedure g_flags2reg(list: TAsmList; size: TCgSize; const f: TResFlags; reg: TRegister); override;
- procedure g_stackpointer_alloc(list : TAsmList;localsize : longint);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 : tcgint);override;
- procedure g_overflowcheck(list: TAsmList; const l: tlocation; def: tdef); override;
- procedure g_save_registers(list : TAsmList);override;
- procedure g_restore_registers(list : TAsmList);override;
- procedure a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel);
- function normalize_ref(list : TAsmList;ref : treference; const refopertypes:trefoperandtypes; out allocatedregs:tregisterlist) : treference;
- procedure adjust_normalized_ref(list: TAsmList;var ref: treference; value: longint);
- procedure emit_mov(list: TAsmList;reg2: tregister; reg1: tregister);
- procedure a_adjust_sp(list: TAsmList; value: longint);
- protected
- procedure a_op_reg_reg_internal(list: TAsmList; Op: TOpCG; size: TCGSize; src, srchi, dst, dsthi: TRegister);
- procedure a_op_const_reg_internal(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; reg, reghi: TRegister);
- procedure gen_multiply(list: TAsmList; op: topcg; size: TCgSize; src2, src1, dst: tregister; check_overflow: boolean);
- end;
- tcg64fz80 = 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;
- end;
- procedure create_codegen;
- const
- TOpCG2AsmOp: Array[topcg] of TAsmOp = (A_NONE,A_LD,A_ADD,A_AND,A_NONE,
- A_NONE,A_NONE,A_NONE,A_NEG,A_CPL,A_OR,
- A_SRA,A_SLA,A_SRL,A_SUB,A_XOR,A_RLCA,A_RRCA);
- implementation
- uses
- globals,verbose,systems,cutils,
- fmodule,
- symconst,symsym,symtable,
- tgobj,rgobj,
- procinfo,cpupi,
- paramgr;
- function use_push(const cgpara:tcgpara):boolean;
- begin
- result:=(not paramanager.use_fixed_stack) and
- assigned(cgpara.location) and
- (cgpara.location^.loc=LOC_REFERENCE) and
- (cgpara.location^.reference.index=NR_STACK_POINTER_REG);
- end;
- procedure tcgz80.init_register_allocators;
- begin
- inherited init_register_allocators;
- rg[R_INTREGISTER]:=trgintcpu.create(R_INTREGISTER,R_SUBWHOLE,
- [RS_A,RS_B,RS_C,RS_D,RS_E,RS_H,RS_L],first_int_imreg,[]);
- end;
- procedure tcgz80.done_register_allocators;
- begin
- rg[R_INTREGISTER].free;
- inherited done_register_allocators;
- end;
- procedure tcgz80.getcpuregisters(list: TAsmList; regs: tregisterlist);
- var
- r: tregister;
- begin
- for r in regs do
- getcpuregister(list,r);
- end;
- procedure tcgz80.ungetcpuregisters(list: TAsmList; regs: tregisterlist);
- var
- r: tregister;
- begin
- for r in regs do
- ungetcpuregister(list,r);
- end;
- function tcgz80.getaddressregister(list: TAsmList): TRegister;
- begin
- Result:=getintregister(list,OS_ADDR);
- end;
- function tcgz80.GetOffsetReg(const r: TRegister; ofs: shortint): TRegister;
- var
- i: Integer;
- begin
- result:=r;
- for i:=1 to ofs do
- result:=GetNextReg(result);
- end;
- function tcgz80.GetOffsetReg64(const r, rhi: TRegister; ofs: shortint): TRegister;
- var
- i: Integer;
- begin
- if ofs>=4 then
- begin
- result:=rhi;
- dec(ofs,4);
- end
- else
- result:=r;
- for i:=1 to ofs do
- result:=GetNextReg(result);
- end;
- procedure tcgz80.a_load_reg_cgpara(list : TAsmList;size : tcgsize;r : tregister;const cgpara : tcgpara);
- procedure load_para_loc(r : TRegister;paraloc : PCGParaLocation);
- var
- ref : treference;
- begin
- paramanager.allocparaloc(list,paraloc);
- case paraloc^.loc of
- LOC_REGISTER,LOC_CREGISTER:
- a_load_reg_reg(list,paraloc^.size,paraloc^.size,r,paraloc^.register);
- LOC_REFERENCE,LOC_CREFERENCE:
- begin
- reference_reset_base(ref,paraloc^.reference.index,paraloc^.reference.offset,ctempposinvalid,2,[]);
- a_load_reg_ref(list,paraloc^.size,paraloc^.size,r,ref);
- end;
- else
- internalerror(2002071003);
- end;
- end;
- var
- i, i2 : longint;
- hp : PCGParaLocation;
- begin
- if use_push(cgpara) then
- begin
- case tcgsize2size[cgpara.Size] of
- 1:
- begin
- cgpara.check_simple_location;
- getcpuregister(list,NR_A);
- a_load_reg_reg(list,OS_8,OS_8,r,NR_A);
- list.concat(taicpu.op_reg(A_PUSH,NR_AF));
- list.concat(taicpu.op_reg(A_INC,NR_SP));
- ungetcpuregister(list,NR_A);
- end;
- 2:
- begin
- cgpara.check_simple_location;
- getcpuregister(list,NR_L);
- a_load_reg_reg(list,OS_8,OS_8,r,NR_L);
- getcpuregister(list,NR_H);
- a_load_reg_reg(list,OS_8,OS_8,GetNextReg(r),NR_H);
- list.concat(taicpu.op_reg(A_PUSH,NR_HL));
- getcpuregister(list,NR_H);
- getcpuregister(list,NR_L);
- end;
- 4:
- begin
- cgpara.check_simple_location;
- getcpuregister(list,NR_L);
- a_load_reg_reg(list,OS_8,OS_8,GetNextReg(GetNextReg(r)),NR_L);
- getcpuregister(list,NR_H);
- a_load_reg_reg(list,OS_8,OS_8,GetNextReg(GetNextReg(GetNextReg(r))),NR_H);
- list.concat(taicpu.op_reg(A_PUSH,NR_HL));
- getcpuregister(list,NR_H);
- getcpuregister(list,NR_L);
- getcpuregister(list,NR_L);
- a_load_reg_reg(list,OS_8,OS_8,r,NR_L);
- getcpuregister(list,NR_H);
- a_load_reg_reg(list,OS_8,OS_8,GetNextReg(r),NR_H);
- list.concat(taicpu.op_reg(A_PUSH,NR_HL));
- getcpuregister(list,NR_H);
- getcpuregister(list,NR_L);
- end;
- else
- internalerror(2020040801);
- end;
- end
- else
- begin
- if not(tcgsize2size[cgpara.Size] in [1..4]) then
- internalerror(2014011101);
- hp:=cgpara.location;
- i:=0;
- while i<tcgsize2size[cgpara.Size] do
- begin
- if not(assigned(hp)) then
- internalerror(2014011102);
- inc(i, tcgsize2size[hp^.Size]);
- if hp^.Loc=LOC_REGISTER then
- begin
- load_para_loc(r,hp);
- hp:=hp^.Next;
- r:=GetNextReg(r);
- end
- else
- begin
- load_para_loc(r,hp);
- for i2:=1 to tcgsize2size[hp^.Size] do
- r:=GetNextReg(r);
- hp:=hp^.Next;
- end;
- end;
- if assigned(hp) then
- internalerror(2014011103);
- end;
- end;
- procedure tcgz80.a_loadfpu_ref_cgpara(list: TAsmList; size: tcgsize; const ref: treference; const cgpara: TCGPara);
- var
- href: treference;
- curloc: PCGParaLocation;
- i: Integer;
- begin
- case cgpara.location^.loc of
- LOC_REGISTER,LOC_CREGISTER:
- begin
- case size of
- OS_F32:
- begin
- curloc:=cgpara.location;
- href:=ref;
- for i:=1 to 4 do
- begin
- if not assigned(curloc) then
- internalerror(2020042303);
- if not (curloc^.Loc in [LOC_REGISTER,LOC_CREGISTER]) then
- internalerror(2020042304);
- a_load_ref_reg(list,OS_8,OS_8,href,curloc^.register);
- curloc:=curloc^.Next;
- end;
- if assigned(curloc) then
- internalerror(2020042305);
- end;
- else
- internalerror(2020042302);
- end;
- end;
- else
- inherited;
- end;
- end;
- procedure tcgz80.a_load_const_cgpara(list : TAsmList;size : tcgsize;a : tcgint;const paraloc : TCGPara);
- var
- i : longint;
- hp : PCGParaLocation;
- ref: treference;
- begin
- if not(tcgsize2size[paraloc.Size] in [1..4]) then
- internalerror(2014011104);
- if use_push(paraloc) then
- begin
- case tcgsize2size[paraloc.Size] of
- 1:
- begin
- getcpuregister(list,NR_A);
- a_load_const_reg(list,OS_8,a,NR_A);
- list.Concat(taicpu.op_reg(A_PUSH,NR_AF));
- list.Concat(taicpu.op_reg(A_INC,NR_SP));
- ungetcpuregister(list,NR_A);
- end;
- 2:
- begin
- getcpuregister(list,NR_IY);
- list.Concat(taicpu.op_reg_const(A_LD,NR_IY,a));
- list.Concat(taicpu.op_reg(A_PUSH,NR_IY));
- ungetcpuregister(list,NR_IY);
- end;
- 4:
- begin
- getcpuregister(list,NR_IY);
- list.Concat(taicpu.op_reg_const(A_LD,NR_IY,Word(a shr 16)));
- list.Concat(taicpu.op_reg(A_PUSH,NR_IY));
- if Word(a)<>Word(a shr 16) then
- list.Concat(taicpu.op_reg_const(A_LD,NR_IY,Word(a)));
- list.Concat(taicpu.op_reg(A_PUSH,NR_IY));
- ungetcpuregister(list,NR_IY);
- end;
- else
- internalerror(2020040701);
- end;
- end
- else
- begin
- hp:=paraloc.location;
- i:=1;
- while i<=tcgsize2size[paraloc.Size] do
- begin
- if not(assigned(hp)) then
- internalerror(2014011105);
- //paramanager.allocparaloc(list,hp);
- case hp^.loc of
- LOC_REGISTER,LOC_CREGISTER:
- begin
- if (tcgsize2size[hp^.size]<>1) or
- (hp^.shiftval<>0) then
- internalerror(2015041101);
- a_load_const_reg(list,hp^.size,(a shr (8*(i-1))) and $ff,hp^.register);
- inc(i,tcgsize2size[hp^.size]);
- hp:=hp^.Next;
- end;
- LOC_REFERENCE,LOC_CREFERENCE:
- begin
- reference_reset(ref,paraloc.alignment,[]);
- ref.base:=hp^.reference.index;
- ref.offset:=hp^.reference.offset;
- a_load_const_ref(list,hp^.size,a shr (8*(i-1)),ref);
- inc(i,tcgsize2size[hp^.size]);
- hp:=hp^.Next;
- end;
- else
- internalerror(2002071005);
- end;
- end;
- end;
- end;
- procedure tcgz80.a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const cgpara : TCGPara);
- procedure pushdata(paraloc:pcgparalocation;ofs:tcgint);
- var
- pushsize : tcgsize;
- opsize : topsize;
- tmpreg : tregister;
- href,tmpref: treference;
- begin
- if not assigned(paraloc) then
- exit;
- if (paraloc^.loc<>LOC_REFERENCE) or
- (paraloc^.reference.index<>NR_STACK_POINTER_REG) or
- (tcgsize2size[paraloc^.size]>4) then
- internalerror(200501162);
- { Pushes are needed in reverse order, add the size of the
- current location to the offset where to load from. This
- prevents wrong calculations for the last location when
- the size is not a power of 2 }
- if assigned(paraloc^.next) then
- pushdata(paraloc^.next,ofs+tcgsize2size[paraloc^.size]);
- { Push the data starting at ofs }
- href:=r;
- inc(href.offset,ofs);
- {if tcgsize2size[paraloc^.size]>cgpara.alignment then}
- pushsize:=paraloc^.size
- {else
- pushsize:=int_cgsize(cgpara.alignment)};
- {Writeln(pushsize);}
- case tcgsize2size[pushsize] of
- 1:
- begin
- tmpreg:=getintregister(list,OS_8);
- a_load_ref_reg(list,paraloc^.size,pushsize,href,tmpreg);
- getcpuregister(list,NR_A);
- a_load_reg_reg(list,OS_8,OS_8,tmpreg,NR_A);
- list.concat(taicpu.op_reg(A_PUSH,NR_AF));
- list.concat(taicpu.op_reg(A_INC,NR_SP));
- ungetcpuregister(list,NR_A);
- end;
- 2:
- begin
- tmpreg:=getintregister(list,OS_16);
- a_load_ref_reg(list,paraloc^.size,pushsize,href,tmpreg);
- getcpuregister(list,NR_L);
- a_load_reg_reg(list,OS_8,OS_8,tmpreg,NR_L);
- getcpuregister(list,NR_H);
- a_load_reg_reg(list,OS_8,OS_8,GetNextReg(tmpreg),NR_H);
- list.concat(taicpu.op_reg(A_PUSH,NR_HL));
- ungetcpuregister(list,NR_H);
- ungetcpuregister(list,NR_L);
- end;
- 4:
- begin
- tmpreg:=getintregister(list,OS_16);
- inc(href.offset,2);
- a_load_ref_reg(list,OS_16,OS_16,href,tmpreg);
- getcpuregister(list,NR_L);
- a_load_reg_reg(list,OS_8,OS_8,tmpreg,NR_L);
- getcpuregister(list,NR_H);
- a_load_reg_reg(list,OS_8,OS_8,GetNextReg(tmpreg),NR_H);
- list.concat(taicpu.op_reg(A_PUSH,NR_HL));
- ungetcpuregister(list,NR_H);
- ungetcpuregister(list,NR_L);
- dec(href.offset,2);
- a_load_ref_reg(list,OS_16,OS_16,href,tmpreg);
- getcpuregister(list,NR_L);
- a_load_reg_reg(list,OS_8,OS_8,tmpreg,NR_L);
- getcpuregister(list,NR_H);
- a_load_reg_reg(list,OS_8,OS_8,GetNextReg(tmpreg),NR_H);
- list.concat(taicpu.op_reg(A_PUSH,NR_HL));
- ungetcpuregister(list,NR_H);
- ungetcpuregister(list,NR_L);
- end;
- else
- internalerror(2020040803);
- end;
- end;
- var
- tmpref, ref, href: treference;
- location: pcgparalocation;
- sizeleft: tcgint;
- len: tcgint;
- begin
- { cgpara.size=OS_NO requires a copy on the stack }
- if use_push(cgpara) then
- begin
- { Record copy? }
- if (cgpara.size in [OS_NO,OS_F64]) or (size=OS_NO) then
- begin
- cgpara.check_simple_location;
- len:=align(cgpara.intsize,cgpara.alignment);
- g_stackpointer_alloc(list,len);
- reference_reset_base(href,NR_STACK_POINTER_REG,0,ctempposinvalid,4,[]);
- g_concatcopy(list,r,href,len);
- end
- else
- begin
- if tcgsize2size[cgpara.size]<>tcgsize2size[size] then
- internalerror(200501161);
- { We need to push the data in reverse order,
- therefor we use a recursive algorithm }
- pushdata(cgpara.location,0);
- end
- end
- else
- begin
- location := cgpara.location;
- tmpref := r;
- sizeleft := cgpara.intsize;
- while assigned(location) do
- begin
- paramanager.allocparaloc(list,location);
- case location^.loc of
- LOC_REGISTER,LOC_CREGISTER:
- 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,ctempposinvalid,cgpara.alignment,[]);
- { 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_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;
- end;
- procedure tcgz80.a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const paraloc : TCGPara);
- var
- tmpreg: tregister;
- begin
- tmpreg:=getaddressregister(list);
- a_loadaddr_ref_reg(list,r,tmpreg);
- a_load_reg_cgpara(list,OS_ADDR,tmpreg,paraloc);
- end;
- procedure tcgz80.a_call_name(list : TAsmList;const s : string; weak: boolean);
- var
- sym: TAsmSymbol;
- begin
- if weak then
- sym:=current_asmdata.WeakRefAsmSymbol(s,AT_FUNCTION)
- else
- sym:=current_asmdata.RefAsmSymbol(s,AT_FUNCTION);
- list.concat(taicpu.op_sym(A_CALL,sym));
- include(current_procinfo.flags,pi_do_call);
- end;
- procedure tcgz80.a_call_reg(list : TAsmList;reg: tregister);
- var
- l : TAsmLabel;
- ref : treference;
- begin
- { HACK: at this point all registers are allocated, due to the way the
- calling convention works, but we need to free some registers, in order
- for the following code to work, so we do it here }
- dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
- getcpuregister(list,NR_L);
- a_load_reg_reg(list,OS_8,OS_8,reg,NR_L);
- getcpuregister(list,NR_H);
- a_load_reg_reg(list,OS_8,OS_8,GetNextReg(reg),NR_H);
- current_asmdata.getjumplabel(l);
- reference_reset(ref,0,[]);
- ref.symbol:=l;
- list.concat(taicpu.op_ref_reg(A_LD,ref,NR_HL));
- ungetcpuregister(list,NR_H);
- ungetcpuregister(list,NR_L);
- { allocate them again, right before the actual call instruction }
- alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
- list.concat(tai_const.Create_8bit($CD)); { $CD is the opcode of the call instruction }
- list.concat(tai_label.Create(l));
- list.concat(tai_const.Create_16bit(0));
- include(current_procinfo.flags,pi_do_call);
- end;
- procedure tcgz80.a_op_const_reg(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; reg: TRegister);
- begin
- if not(size in [OS_S8,OS_8,OS_S16,OS_16,OS_S32,OS_32]) then
- internalerror(2012102403);
- a_op_const_reg_internal(list,Op,size,a,reg,NR_NO);
- end;
- procedure tcgz80.a_op_reg_reg(list: TAsmList; Op: TOpCG; size: TCGSize; src, dst : TRegister);
- begin
- if not(size in [OS_S8,OS_8,OS_S16,OS_16,OS_S32,OS_32]) then
- internalerror(2012102401);
- a_op_reg_reg_internal(list,Op,size,src,NR_NO,dst,NR_NO);
- end;
- procedure tcgz80.a_op_reg_reg_internal(list : TAsmList; Op: TOpCG; size: TCGSize; src, srchi, dst, dsthi: TRegister);
- var
- i : integer;
- procedure NextSrcDst;
- begin
- if i=5 then
- begin
- dst:=dsthi;
- src:=srchi;
- end
- else
- begin
- dst:=GetNextReg(dst);
- src:=GetNextReg(src);
- end;
- end;
- var
- tmpreg,tmpreg2: tregister;
- instr : taicpu;
- l1,l2 : tasmlabel;
- begin
- case op of
- OP_ADD:
- begin
- getcpuregister(list,NR_A);
- a_load_reg_reg(list,OS_8,OS_8,dst,NR_A);
- list.concat(taicpu.op_reg_reg(A_ADD,NR_A,src));
- a_load_reg_reg(list,OS_8,OS_8,NR_A,dst);
- if size in [OS_S16,OS_16,OS_S32,OS_32,OS_S64,OS_64] then
- begin
- for i:=2 to tcgsize2size[size] do
- begin
- NextSrcDst;
- a_load_reg_reg(list,OS_8,OS_8,dst,NR_A);
- list.concat(taicpu.op_reg_reg(A_ADC,NR_A,src));
- a_load_reg_reg(list,OS_8,OS_8,NR_A,dst);
- end;
- end;
- ungetcpuregister(list,NR_A);
- end;
- OP_SUB:
- begin
- getcpuregister(list,NR_A);
- a_load_reg_reg(list,OS_8,OS_8,dst,NR_A);
- list.concat(taicpu.op_reg_reg(A_SUB,NR_A,src));
- a_load_reg_reg(list,OS_8,OS_8,NR_A,dst);
- if size in [OS_S16,OS_16,OS_S32,OS_32,OS_S64,OS_64] then
- begin
- for i:=2 to tcgsize2size[size] do
- begin
- NextSrcDst;
- a_load_reg_reg(list,OS_8,OS_8,dst,NR_A);
- list.concat(taicpu.op_reg_reg(A_SBC,NR_A,src));
- a_load_reg_reg(list,OS_8,OS_8,NR_A,dst);
- end;
- end;
- ungetcpuregister(list,NR_A);
- end;
- OP_NEG:
- begin
- getcpuregister(list,NR_A);
- if tcgsize2size[size]>=2 then
- begin
- tmpreg:=GetNextReg(src);
- tmpreg2:=GetNextReg(dst);
- for i:=2 to tcgsize2size[size] do
- begin
- a_load_reg_reg(list,OS_8,OS_8,tmpreg,NR_A);
- list.concat(taicpu.op_none(A_CPL));
- a_load_reg_reg(list,OS_8,OS_8,NR_A,tmpreg2);
- if i<>tcgsize2size[size] then
- begin
- if i=4 then
- begin
- tmpreg:=srchi;
- tmpreg2:=dsthi;
- end
- else
- begin
- tmpreg:=GetNextReg(tmpreg);
- tmpreg2:=GetNextReg(tmpreg2);
- end;
- end;
- end;
- end;
- a_load_reg_reg(list,OS_8,OS_8,src,NR_A);
- list.concat(taicpu.op_none(A_NEG));
- a_load_reg_reg(list,OS_8,OS_8,NR_A,dst);
- if tcgsize2size[size]>=2 then
- begin
- tmpreg2:=GetNextReg(dst);
- for i:=2 to tcgsize2size[size] do
- begin
- a_load_reg_reg(list,OS_8,OS_8,tmpreg2,NR_A);
- list.concat(taicpu.op_reg_const(A_SBC,NR_A,-1));
- a_load_reg_reg(list,OS_8,OS_8,NR_A,tmpreg2);
- if i<>tcgsize2size[size] then
- begin
- if i=4 then
- begin
- tmpreg2:=dsthi;
- end
- else
- begin
- tmpreg2:=GetNextReg(tmpreg2);
- end;
- end;
- end;
- end;
- ungetcpuregister(list,NR_A);
- end;
- OP_NOT:
- begin
- getcpuregister(list,NR_A);
- for i:=1 to tcgsize2size[size] do
- begin
- if i<>1 then
- NextSrcDst;
- a_load_reg_reg(list,OS_8,OS_8,src,NR_A);
- list.concat(taicpu.op_none(A_CPL));
- a_load_reg_reg(list,OS_8,OS_8,NR_A,dst);
- end;
- ungetcpuregister(list,NR_A);
- end;
- OP_MUL,OP_IMUL:
- begin
- tmpreg:=dst;
- if size in [OS_16,OS_S16] then
- begin
- tmpreg:=getintregister(list,size);
- a_load_reg_reg(list,size,size,dst,tmpreg);
- end;
- gen_multiply(list,op,size,src,tmpreg,dst,false);
- end;
- OP_DIV,OP_IDIV:
- { special stuff, needs separate handling inside code
- generator }
- internalerror(2017032604);
- OP_SHR,OP_SHL,OP_SAR,OP_ROL,OP_ROR:
- begin
- current_asmdata.getjumplabel(l1);
- current_asmdata.getjumplabel(l2);
- getcpuregister(list,NR_B);
- emit_mov(list,NR_B,src);
- list.concat(taicpu.op_reg(A_INC,NR_B));
- list.concat(taicpu.op_reg(A_DEC,NR_B));
- a_jmp_flags(list,F_E,l2);
- if size in [OS_S16,OS_16,OS_S32,OS_32,OS_S64,OS_64] then
- case op of
- OP_ROL:
- begin
- list.concat(taicpu.op_reg(A_RRC,GetOffsetReg64(dst,dsthi,tcgsize2size[size]-1)));
- list.concat(taicpu.op_reg(A_RLC,GetOffsetReg64(dst,dsthi,tcgsize2size[size]-1)));
- end;
- OP_ROR:
- begin
- list.concat(taicpu.op_reg(A_RLC,dst));
- list.concat(taicpu.op_reg(A_RRC,dst));
- end;
- else
- ;
- end;
- cg.a_label(list,l1);
- case op of
- OP_SHL:
- list.concat(taicpu.op_reg(A_SLA,dst));
- OP_SHR:
- list.concat(taicpu.op_reg(A_SRL,GetOffsetReg64(dst,dsthi,tcgsize2size[size]-1)));
- OP_SAR:
- list.concat(taicpu.op_reg(A_SRA,GetOffsetReg64(dst,dsthi,tcgsize2size[size]-1)));
- OP_ROL:
- if size in [OS_8,OS_S8] then
- list.concat(taicpu.op_reg(A_RLC,dst))
- else
- list.concat(taicpu.op_reg(A_RL,dst));
- OP_ROR:
- if size in [OS_8,OS_S8] then
- list.concat(taicpu.op_reg(A_RRC,GetOffsetReg64(dst,dsthi,tcgsize2size[size]-1)))
- else
- list.concat(taicpu.op_reg(A_RR,GetOffsetReg64(dst,dsthi,tcgsize2size[size]-1)));
- else
- internalerror(2020040903);
- end;
- if size in [OS_S16,OS_16,OS_S32,OS_32,OS_S64,OS_64] then
- begin
- for i:=2 to tcgsize2size[size] do
- begin
- case op of
- OP_ROR,
- OP_SHR,
- OP_SAR:
- list.concat(taicpu.op_reg(A_RR,GetOffsetReg64(dst,dsthi,tcgsize2size[size]-i)));
- OP_ROL,
- OP_SHL:
- list.concat(taicpu.op_reg(A_RL,GetOffsetReg64(dst,dsthi,i-1)));
- else
- internalerror(2020040904);
- end;
- end;
- end;
- instr:=taicpu.op_sym(A_DJNZ,l1);
- instr.is_jmp:=true;
- list.concat(instr);
- ungetcpuregister(list,NR_B);
- cg.a_label(list,l2);
- end;
- OP_AND,OP_OR,OP_XOR:
- begin
- getcpuregister(list,NR_A);
- for i:=1 to tcgsize2size[size] do
- begin
- if i<>1 then
- NextSrcDst;
- a_load_reg_reg(list,OS_8,OS_8,dst,NR_A);
- list.concat(taicpu.op_reg_reg(topcg2asmop[op],NR_A,src));
- a_load_reg_reg(list,OS_8,OS_8,NR_A,dst);
- end;
- ungetcpuregister(list,NR_A);
- end;
- else
- internalerror(2011022004);
- end;
- end;
- procedure tcgz80.a_op_const_reg_internal(list: TAsmList; Op: TOpCG;
- size: TCGSize; a: tcgint; reg, reghi: TRegister);
- var
- i : byte;
- procedure NextReg;
- begin
- if i=4 then
- reg:=reghi
- else
- reg:=GetNextReg(reg);
- end;
- var
- mask : qword;
- shift : byte;
- curvalue : byte;
- tmpop: TAsmOp;
- l1: TAsmLabel;
- instr: taicpu;
- tmpreg : tregister;
- tmpreg64 : tregister64;
- begin
- optimize_op_const(size,op,a);
- mask:=$ff;
- shift:=0;
- l1:=nil;
- case op of
- OP_NONE:
- begin
- { Opcode is optimized away }
- end;
- OP_MOVE:
- begin
- { Optimized, replaced with a simple load }
- a_load_const_reg(list,size,a,reg);
- end;
- OP_AND:
- begin
- curvalue:=a and mask;
- for i:=1 to tcgsize2size[size] do
- begin
- case curvalue of
- 0:
- list.concat(taicpu.op_reg_const(A_LD,reg,0));
- $ff:
- {nothing};
- else
- begin
- getcpuregister(list,NR_A);
- emit_mov(list,NR_A,reg);
- list.concat(taicpu.op_reg_const(A_AND,NR_A,curvalue));
- emit_mov(list,reg,NR_A);
- ungetcpuregister(list,NR_A);
- end;
- end;
- if i<>tcgsize2size[size] then
- begin
- NextReg;
- mask:=mask shl 8;
- inc(shift,8);
- curvalue:=(qword(a) and mask) shr shift;
- end;
- end;
- end;
- OP_OR:
- begin
- curvalue:=a and mask;
- for i:=1 to tcgsize2size[size] do
- begin
- case curvalue of
- 0:
- {nothing};
- $ff:
- list.concat(taicpu.op_reg_const(A_LD,reg,$ff));
- else
- begin
- getcpuregister(list,NR_A);
- emit_mov(list,NR_A,reg);
- list.concat(taicpu.op_reg_const(A_OR,NR_A,curvalue));
- emit_mov(list,reg,NR_A);
- ungetcpuregister(list,NR_A);
- end;
- end;
- if i<>tcgsize2size[size] then
- begin
- NextReg;
- mask:=mask shl 8;
- inc(shift,8);
- curvalue:=(qword(a) and mask) shr shift;
- end;
- end;
- end;
- OP_XOR:
- begin
- curvalue:=a and mask;
- for i:=1 to tcgsize2size[size] do
- begin
- case curvalue of
- 0:
- {nothing};
- $ff:
- begin
- getcpuregister(list,NR_A);
- emit_mov(list,NR_A,reg);
- list.concat(taicpu.op_none(A_CPL));
- emit_mov(list,reg,NR_A);
- ungetcpuregister(list,NR_A);
- end;
- else
- begin
- getcpuregister(list,NR_A);
- emit_mov(list,NR_A,reg);
- list.concat(taicpu.op_reg_const(A_XOR,NR_A,curvalue));
- emit_mov(list,reg,NR_A);
- ungetcpuregister(list,NR_A);
- end;
- end;
- if i<>tcgsize2size[size] then
- begin
- NextReg;
- mask:=mask shl 8;
- inc(shift,8);
- curvalue:=(qword(a) and mask) shr shift;
- end;
- end;
- end;
- OP_SHR,OP_SHL,OP_SAR,OP_ROL,OP_ROR:
- begin
- if size in [OS_64,OS_S64] then
- a:=a and 63
- else
- a:=a and 31;
- if a<>0 then
- begin
- if a>1 then
- begin
- current_asmdata.getjumplabel(l1);
- getcpuregister(list,NR_B);
- list.concat(taicpu.op_reg_const(A_LD,NR_B,a));
- end;
- if size in [OS_S16,OS_16,OS_S32,OS_32,OS_S64,OS_64] then
- case op of
- OP_ROL:
- begin
- list.concat(taicpu.op_reg(A_RRC,GetOffsetReg64(reg,reghi,tcgsize2size[size]-1)));
- list.concat(taicpu.op_reg(A_RLC,GetOffsetReg64(reg,reghi,tcgsize2size[size]-1)));
- end;
- OP_ROR:
- begin
- list.concat(taicpu.op_reg(A_RLC,reg));
- list.concat(taicpu.op_reg(A_RRC,reg));
- end;
- else
- ;
- end;
- if a>1 then
- cg.a_label(list,l1);
- case op of
- OP_SHL:
- list.concat(taicpu.op_reg(A_SLA,reg));
- OP_SHR:
- list.concat(taicpu.op_reg(A_SRL,GetOffsetReg64(reg,reghi,tcgsize2size[size]-1)));
- OP_SAR:
- list.concat(taicpu.op_reg(A_SRA,GetOffsetReg64(reg,reghi,tcgsize2size[size]-1)));
- OP_ROL:
- if size in [OS_8,OS_S8] then
- list.concat(taicpu.op_reg(A_RLC,reg))
- else
- list.concat(taicpu.op_reg(A_RL,reg));
- OP_ROR:
- if size in [OS_8,OS_S8] then
- list.concat(taicpu.op_reg(A_RRC,GetOffsetReg64(reg,reghi,tcgsize2size[size]-1)))
- else
- list.concat(taicpu.op_reg(A_RR,GetOffsetReg64(reg,reghi,tcgsize2size[size]-1)));
- else
- internalerror(2020040905);
- end;
- if size in [OS_S16,OS_16,OS_S32,OS_32,OS_S64,OS_64] then
- begin
- for i:=2 to tcgsize2size[size] do
- begin
- case op of
- OP_ROR,
- OP_SHR,
- OP_SAR:
- list.concat(taicpu.op_reg(A_RR,GetOffsetReg64(reg,reghi,tcgsize2size[size]-i)));
- OP_ROL,
- OP_SHL:
- list.concat(taicpu.op_reg(A_RL,GetOffsetReg64(reg,reghi,i-1)));
- else
- internalerror(2020040906);
- end;
- end;
- end;
- if a>1 then
- begin
- instr:=taicpu.op_sym(A_DJNZ,l1);
- instr.is_jmp:=true;
- list.concat(instr);
- ungetcpuregister(list,NR_B);
- end;
- end;
- end;
- OP_ADD:
- begin
- curvalue:=a and mask;
- tmpop:=A_NONE;
- for i:=1 to tcgsize2size[size] do
- begin
- if (tmpop=A_NONE) and (curvalue=1) and (i=tcgsize2size[size]) then
- tmpop:=A_INC
- else if (tmpop=A_NONE) and (curvalue=255) and (i=tcgsize2size[size]) then
- tmpop:=A_DEC
- else if (tmpop=A_NONE) and (curvalue<>0) then
- tmpop:=A_ADD
- else if tmpop=A_ADD then
- tmpop:=A_ADC;
- case tmpop of
- A_NONE:
- {nothing};
- A_INC,A_DEC:
- list.concat(taicpu.op_reg(tmpop,reg));
- A_ADD,A_ADC:
- begin
- getcpuregister(list,NR_A);
- emit_mov(list,NR_A,reg);
- list.concat(taicpu.op_reg_const(tmpop,NR_A,curvalue));
- emit_mov(list,reg,NR_A);
- ungetcpuregister(list,NR_A);
- end;
- else
- internalerror(2020040901);
- end;
- if i<>tcgsize2size[size] then
- begin
- NextReg;
- mask:=mask shl 8;
- inc(shift,8);
- curvalue:=(qword(a) and mask) shr shift;
- end;
- end;
- end;
- OP_SUB:
- begin
- curvalue:=a and mask;
- tmpop:=A_NONE;
- for i:=1 to tcgsize2size[size] do
- begin
- if (tmpop=A_NONE) and (curvalue=1) and (i=tcgsize2size[size]) then
- tmpop:=A_DEC
- else if (tmpop=A_NONE) and (curvalue=255) and (i=tcgsize2size[size]) then
- tmpop:=A_INC
- else if (tmpop=A_NONE) and (curvalue<>0) then
- tmpop:=A_SUB
- else if tmpop=A_SUB then
- tmpop:=A_SBC;
- case tmpop of
- A_NONE:
- {nothing};
- A_DEC,A_INC:
- list.concat(taicpu.op_reg(tmpop,reg));
- A_SUB,A_SBC:
- begin
- getcpuregister(list,NR_A);
- emit_mov(list,NR_A,reg);
- list.concat(taicpu.op_reg_const(tmpop,NR_A,curvalue));
- emit_mov(list,reg,NR_A);
- ungetcpuregister(list,NR_A);
- end;
- else
- internalerror(2020040902);
- end;
- if i<>tcgsize2size[size] then
- begin
- NextReg;
- mask:=mask shl 8;
- inc(shift,8);
- curvalue:=(qword(a) and mask) shr shift;
- end;
- end;
- end;
- else
- begin
- if size in [OS_64,OS_S64] then
- begin
- tmpreg64.reglo:=getintregister(list,OS_32);
- tmpreg64.reghi:=getintregister(list,OS_32);
- cg64.a_load64_const_reg(list,a,tmpreg64);
- cg64.a_op64_reg_reg(list,op,size,tmpreg64,joinreg64(reg,reghi));
- end
- else
- begin
- {$if 0}
- { code not working yet }
- if (op=OP_SAR) and (a=31) and (size in [OS_32,OS_S32]) then
- begin
- tmpreg:=reg;
- for i:=1 to 4 do
- begin
- list.concat(taicpu.op_reg_reg(A_MOV,tmpreg,NR_R1));
- tmpreg:=GetNextReg(tmpreg);
- end;
- end
- else
- {$endif}
- begin
- tmpreg:=getintregister(list,size);
- a_load_const_reg(list,size,a,tmpreg);
- a_op_reg_reg(list,op,size,tmpreg,reg);
- end;
- end;
- end;
- end;
- end;
- procedure tcgz80.gen_multiply(list: TAsmList; op: topcg; size: TCgSize; src2, src1, dst: tregister; check_overflow: boolean);
- var
- pd: tprocdef;
- paraloc1, paraloc2: tcgpara;
- ai: taicpu;
- hl, no_overflow: TAsmLabel;
- name: String;
- begin
- if size in [OS_8,OS_S8] then
- begin
- if size=OS_8 then
- name:='fpc_mul_byte'
- else
- name:='fpc_mul_shortint';
- if check_overflow then
- name:=name+'_checkoverflow';
- pd:=search_system_proc(name);
- paraloc1.init;
- paraloc2.init;
- paramanager.getcgtempparaloc(list,pd,1,paraloc1);
- paramanager.getcgtempparaloc(list,pd,2,paraloc2);
- a_load_reg_cgpara(list,OS_8,src1,paraloc2);
- a_load_reg_cgpara(list,OS_8,src2,paraloc1);
- paramanager.freecgpara(list,paraloc2);
- paramanager.freecgpara(list,paraloc1);
- alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
- a_call_name(list,upper(name),false);
- dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
- cg.a_reg_alloc(list,NR_L);
- cg.a_load_reg_reg(list,OS_8,OS_8,NR_L,dst);
- cg.a_reg_dealloc(list,NR_L);
- paraloc2.done;
- paraloc1.done;
- end
- else if size in [OS_16,OS_S16] then
- begin
- if size=OS_16 then
- name:='fpc_mul_word'
- else
- name:='fpc_mul_integer';
- if check_overflow then
- name:=name+'_checkoverflow';
- pd:=search_system_proc(name);
- paraloc1.init;
- paraloc2.init;
- paramanager.getcgtempparaloc(list,pd,1,paraloc1);
- paramanager.getcgtempparaloc(list,pd,2,paraloc2);
- a_load_reg_cgpara(list,OS_16,src1,paraloc2);
- a_load_reg_cgpara(list,OS_16,src2,paraloc1);
- paramanager.freecgpara(list,paraloc2);
- paramanager.freecgpara(list,paraloc1);
- alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
- a_call_name(list,upper(name),false);
- dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
- cg.a_reg_alloc(list,NR_L);
- cg.a_reg_alloc(list,NR_H);
- cg.a_load_reg_reg(list,OS_8,OS_8,NR_L,dst);
- cg.a_reg_dealloc(list,NR_L);
- cg.a_load_reg_reg(list,OS_8,OS_8,NR_H,GetNextReg(dst));
- cg.a_reg_dealloc(list,NR_H);
- paraloc2.done;
- paraloc1.done;
- end
- else
- internalerror(2011022002);
- end;
- procedure tcgz80.a_load_const_reg(list : TAsmList; size: tcgsize; a : tcgint;reg : tregister);
- var
- mask : qword;
- shift : byte;
- i : byte;
- begin
- mask:=$ff;
- shift:=0;
- for i:=tcgsize2size[size] downto 1 do
- begin
- list.Concat(taicpu.op_reg_const(A_LD,reg,(qword(a) and mask) shr shift));
- if i<>1 then
- begin
- mask:=mask shl 8;
- inc(shift,8);
- reg:=GetNextReg(reg);
- end;
- end;
- end;
- procedure tcgz80.a_load_const_ref(list: TAsmList; size: tcgsize; a: tcgint; const ref: treference);
- var
- mask : qword;
- shift : byte;
- href: treference;
- i: Integer;
- begin
- mask:=$ff;
- shift:=0;
- href:=ref;
- if (href.base=NR_NO) and (href.index<>NR_NO) then
- begin
- href.base:=href.index;
- href.index:=NR_NO;
- end;
- if is_ref_in_opertypes(href,[OT_REF_IX_d,OT_REF_IY_d]) or
- (is_ref_hl(href) and (size in [OS_8,OS_S8])) then
- begin
- for i:=tcgsize2size[size] downto 1 do
- begin
- list.Concat(taicpu.op_ref_const(A_LD,href,(qword(a) and mask) shr shift));
- if i<>1 then
- begin
- mask:=mask shl 8;
- inc(shift,8);
- inc(href.offset);
- end;
- end;
- end
- else
- inherited;
- end;
- function tcgz80.normalize_ref(list: TAsmList; ref: treference;
- const refopertypes: trefoperandtypes; out allocatedregs: tregisterlist): treference;
- var
- tmpref : treference;
- l : tasmlabel;
- begin
- SetLength(allocatedregs,0);
- if (ref.base=NR_NO) and (ref.index<>NR_NO) and (ref.scalefactor<=1) then
- begin
- ref.base:=ref.index;
- ref.index:=NR_NO;
- end;
- if is_ref_in_opertypes(ref,refopertypes) then
- begin
- Result:=ref;
- exit;
- end;
- { can we use the HL register? }
- if OT_REF_HL in refopertypes then
- begin
- SetLength(allocatedregs,2);
- allocatedregs[0]:=NR_H;
- allocatedregs[1]:=NR_L;
- getcpuregisters(list,allocatedregs);
- if assigned(ref.symbol) or (ref.offset<>0) then
- begin
- if assigned(ref.symbol) then
- begin
- reference_reset(tmpref,0,[]);
- tmpref.symbol:=ref.symbol;
- tmpref.offset:=ref.offset;
- tmpref.refaddr:=addr_full;
- list.concat(taicpu.op_reg_ref(A_LD,NR_HL,tmpref));
- end
- else
- list.concat(taicpu.op_reg_const(A_LD,NR_HL,ref.offset));
- if (ref.base=NR_IX) or (ref.base=NR_IY) then
- begin
- getcpuregister(list,NR_D);
- getcpuregister(list,NR_E);
- list.concat(taicpu.op_reg(A_PUSH,ref.base));
- list.concat(taicpu.op_reg(A_POP,NR_DE));
- list.concat(taicpu.op_reg_reg(A_ADD,NR_HL,NR_DE));
- ungetcpuregister(list,NR_E);
- ungetcpuregister(list,NR_D);
- end
- else if ref.base<>NR_NO then
- begin
- getcpuregister(list,NR_A);
- emit_mov(list,NR_A,NR_L);
- list.concat(taicpu.op_reg_reg(A_ADD,NR_A,ref.base));
- emit_mov(list,NR_L,NR_A);
- emit_mov(list,NR_A,NR_H);
- list.concat(taicpu.op_reg_reg(A_ADC,NR_A,GetNextReg(ref.base)));
- emit_mov(list,NR_H,NR_A);
- ungetcpuregister(list,NR_A);
- end;
- if ref.index<>NR_NO then
- begin
- if ref.scalefactor>1 then
- internalerror(2020042002);
- getcpuregister(list,NR_A);
- emit_mov(list,NR_A,NR_L);
- list.concat(taicpu.op_reg_reg(A_ADD,NR_A,ref.index));
- emit_mov(list,NR_L,NR_A);
- emit_mov(list,NR_A,NR_H);
- list.concat(taicpu.op_reg_reg(A_ADC,NR_A,GetNextReg(ref.index)));
- emit_mov(list,NR_H,NR_A);
- ungetcpuregister(list,NR_A);
- end;
- end
- else
- begin
- { not assigned(ref.symbol) and (ref.offset=0) }
- if (ref.base=NR_IX) or (ref.base=NR_IY) then
- begin
- list.concat(taicpu.op_reg(A_PUSH,ref.base));
- list.concat(taicpu.op_reg(A_POP,NR_HL));
- end
- else if ref.base<>NR_NO then
- begin
- emit_mov(list,NR_L,ref.base);
- emit_mov(list,NR_H,GetNextReg(ref.base));
- end;
- if ref.index<>NR_NO then
- begin
- if ref.scalefactor>1 then
- internalerror(2020042003);
- getcpuregister(list,NR_A);
- emit_mov(list,NR_A,NR_L);
- list.concat(taicpu.op_reg_reg(A_ADD,NR_A,ref.index));
- emit_mov(list,NR_L,NR_A);
- emit_mov(list,NR_A,NR_H);
- list.concat(taicpu.op_reg_reg(A_ADC,NR_A,GetNextReg(ref.index)));
- emit_mov(list,NR_H,NR_A);
- ungetcpuregister(list,NR_A);
- end;
- end;
- reference_reset_base(result,NR_HL,0,ctempposinvalid,0,[]);
- end
- else
- internalerror(2020042001);
- end;
- procedure tcgz80.adjust_normalized_ref(list: TAsmList; var ref: treference; value: longint);
- var
- i: Integer;
- begin
- if is_ref_addr16(ref) then
- Inc(ref.offset,value)
- else if is_ref_hl(ref) then
- begin
- if value>0 then
- for i:=1 to value do
- list.concat(taicpu.op_reg(A_INC,NR_HL))
- else
- for i:=-1 downto value do
- list.concat(taicpu.op_reg(A_DEC,NR_HL));
- end
- else if is_ref_ix_d(ref) then
- begin
- if ((ref.offset+value)<=127) and ((ref.offset+value)>=-128) then
- inc(ref.offset,value)
- else
- begin
- { todo: IX is the frame pointer, we cannot change it, so we }
- { think of another mechanism to deal with this situation }
- internalerror(2020042101);
- //if value>0 then
- // for i:=1 to value do
- // list.concat(taicpu.op_reg(A_INC,NR_IX))
- //else
- // for i:=-1 downto value do
- // list.concat(taicpu.op_reg(A_DEC,NR_IX));
- end;
- end
- else if is_ref_iy_d(ref) then
- begin
- if ((ref.offset+value)<=127) and ((ref.offset+value)>=-128) then
- inc(ref.offset,value)
- else
- if value>0 then
- for i:=1 to value do
- list.concat(taicpu.op_reg(A_INC,NR_IY))
- else
- for i:=-1 downto value do
- list.concat(taicpu.op_reg(A_DEC,NR_IY));
- end;
- end;
- procedure tcgz80.a_load_reg_ref(list : TAsmList; fromsize, tosize: tcgsize; reg : tregister;const ref : treference);
- var
- href : treference;
- i : integer;
- regsused: tregisterlist;
- begin
- if (tcgsize2size[fromsize]>32) or (tcgsize2size[tosize]>32) or (fromsize=OS_NO) or (tosize=OS_NO) then
- internalerror(2011021307);
- if tcgsize2size[fromsize]>tcgsize2size[tosize] then
- internalerror(2020040802);
- href:=normalize_ref(list,Ref,[OT_REF_ADDR16,OT_REF_HL,OT_REF_IX_d,OT_REF_IY_d],regsused);
- if (tcgsize2size[fromsize]=tcgsize2size[tosize]) or (fromsize in [OS_8,OS_16,OS_32]) then
- begin
- getcpuregister(list,NR_A);
- for i:=1 to tcgsize2size[fromsize] do
- begin
- a_load_reg_reg(list,OS_8,OS_8,reg,NR_A);
- list.concat(taicpu.op_ref_reg(A_LD,href,NR_A));
- if i<>tcgsize2size[fromsize] then
- reg:=GetNextReg(reg);
- if i<>tcgsize2size[tosize] then
- adjust_normalized_ref(list,href,1);
- end;
- for i:=tcgsize2size[fromsize]+1 to tcgsize2size[tosize] do
- begin
- if i=(tcgsize2size[fromsize]+1) then
- list.concat(taicpu.op_reg_const(A_LD,NR_A,0));
- list.concat(taicpu.op_ref_reg(A_LD,href,NR_A));
- if i<>tcgsize2size[tosize] then
- begin
- adjust_normalized_ref(list,href,1);
- reg:=GetNextReg(reg);
- end;
- end;
- ungetcpuregister(list,NR_A);
- end
- else
- begin
- getcpuregister(list,NR_A);
- for i:=1 to tcgsize2size[fromsize] do
- begin
- a_load_reg_reg(list,OS_8,OS_8,reg,NR_A);
- list.concat(taicpu.op_ref_reg(A_LD,href,NR_A));
- if i<>tcgsize2size[fromsize] then
- reg:=GetNextReg(reg);
- if i<>tcgsize2size[tosize] then
- adjust_normalized_ref(list,href,1);
- end;
- list.concat(taicpu.op_none(A_RLA));
- list.concat(taicpu.op_reg_reg(A_SBC,NR_A,NR_A));
- for i:=tcgsize2size[fromsize]+1 to tcgsize2size[tosize] do
- begin
- list.concat(taicpu.op_ref_reg(A_LD,href,NR_A));
- if i<>tcgsize2size[tosize] then
- begin
- adjust_normalized_ref(list,href,1);
- reg:=GetNextReg(reg);
- end;
- end;
- ungetcpuregister(list,NR_A);
- end;
- ungetcpuregisters(list,regsused);
- end;
- procedure tcgz80.a_load_ref_reg(list : TAsmList; fromsize, tosize : tcgsize;
- const Ref : treference;reg : tregister);
- var
- href : treference;
- i : integer;
- regsused: tregisterlist;
- begin
- if (tcgsize2size[fromsize]>32) or (tcgsize2size[tosize]>32) or (fromsize=OS_NO) or (tosize=OS_NO) then
- internalerror(2011021301);
- if tcgsize2size[fromsize]>=tcgsize2size[tosize] then
- fromsize:=tosize;
- href:=normalize_ref(list,Ref,[OT_REF_ADDR16,OT_REF_HL,OT_REF_IX_d,OT_REF_IY_d],regsused);
- if (tcgsize2size[tosize]=tcgsize2size[fromsize]) or (fromsize in [OS_8,OS_16,OS_32]) then
- begin
- getcpuregister(list,NR_A);
- for i:=1 to tcgsize2size[fromsize] do
- begin
- list.concat(taicpu.op_reg_ref(A_LD,NR_A,href));
- a_load_reg_reg(list,OS_8,OS_8,NR_A,reg);
- if i<>tcgsize2size[fromsize] then
- adjust_normalized_ref(list,href,1);
- if i<>tcgsize2size[tosize] then
- reg:=GetNextReg(reg);
- end;
- ungetcpuregisters(list,regsused);
- ungetcpuregister(list,NR_A);
- for i:=tcgsize2size[fromsize]+1 to tcgsize2size[tosize] do
- begin
- list.concat(taicpu.op_reg_const(A_LD,reg,0));
- if i<>tcgsize2size[tosize] then
- reg:=GetNextReg(reg);
- end;
- end
- else
- begin
- getcpuregister(list,NR_A);
- for i:=1 to tcgsize2size[fromsize] do
- begin
- list.concat(taicpu.op_reg_ref(A_LD,NR_A,href));
- a_load_reg_reg(list,OS_8,OS_8,NR_A,reg);
- if i<>tcgsize2size[fromsize] then
- adjust_normalized_ref(list,href,1);
- if i<>tcgsize2size[tosize] then
- reg:=GetNextReg(reg);
- end;
- ungetcpuregisters(list,regsused);
- list.concat(taicpu.op_none(A_RLA));
- list.concat(taicpu.op_reg_reg(A_SBC,NR_A,NR_A));
- for i:=tcgsize2size[fromsize]+1 to tcgsize2size[tosize] do
- begin
- emit_mov(list,reg,NR_A);
- if i<>tcgsize2size[tosize] then
- reg:=GetNextReg(reg);
- end;
- ungetcpuregister(list,NR_A);
- end;
- end;
- procedure tcgz80.a_load_reg_reg(list : TAsmList; fromsize, tosize : tcgsize;reg1,reg2 : tregister);
- var
- conv_done: boolean;
- tmpreg : tregister;
- i : integer;
- begin
- if (tcgsize2size[fromsize]>32) or (tcgsize2size[tosize]>32) or (fromsize=OS_NO) or (tosize=OS_NO) then
- internalerror(2011021310);
- if tcgsize2size[fromsize]>tcgsize2size[tosize] then
- fromsize:=tosize;
- if (tcgsize2size[tosize]=tcgsize2size[fromsize]) or (fromsize in [OS_8,OS_16,OS_32]) then
- begin
- if reg1<>reg2 then
- for i:=1 to tcgsize2size[fromsize] do
- begin
- emit_mov(list,reg2,reg1);
- if i<>tcgsize2size[fromsize] then
- reg1:=GetNextReg(reg1);
- if i<>tcgsize2size[tosize] then
- reg2:=GetNextReg(reg2);
- end
- else
- for i:=1 to tcgsize2size[fromsize] do
- if i<>tcgsize2size[tosize] then
- reg2:=GetNextReg(reg2);
- for i:=tcgsize2size[fromsize]+1 to tcgsize2size[tosize] do
- begin
- list.Concat(taicpu.op_reg_const(A_LD,reg2,0));
- if i<>tcgsize2size[tosize] then
- reg2:=GetNextReg(reg2);
- end
- end
- else
- begin
- if reg1<>reg2 then
- for i:=1 to tcgsize2size[fromsize]-1 do
- begin
- emit_mov(list,reg2,reg1);
- reg1:=GetNextReg(reg1);
- reg2:=GetNextReg(reg2);
- end
- else
- for i:=1 to tcgsize2size[fromsize]-1 do
- reg2:=GetNextReg(reg2);
- emit_mov(list,reg2,reg1);
- getcpuregister(list,NR_A);
- emit_mov(list,NR_A,reg2);
- reg2:=GetNextReg(reg2);
- list.concat(taicpu.op_none(A_RLA));
- list.concat(taicpu.op_reg_reg(A_SBC,NR_A,NR_A));
- for i:=tcgsize2size[fromsize]+1 to tcgsize2size[tosize] do
- begin
- emit_mov(list,reg2,NR_A);
- if i<>tcgsize2size[tosize] then
- reg2:=GetNextReg(reg2);
- end;
- ungetcpuregister(list,NR_A);
- end;
- end;
- procedure tcgz80.a_loadfpu_reg_reg(list: TAsmList; fromsize,tosize: tcgsize; reg1, reg2: tregister);
- begin
- internalerror(2012010702);
- end;
- procedure tcgz80.a_loadfpu_ref_reg(list: TAsmList; fromsize,tosize: tcgsize; const ref: treference; reg: tregister);
- begin
- internalerror(2012010703);
- end;
- procedure tcgz80.a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference);
- begin
- internalerror(2012010704);
- end;
- { comparison operations }
- procedure tcgz80.a_cmp_const_reg_label(list : TAsmList;size : tcgsize;
- cmp_op : topcmp;a : tcgint;reg : tregister;l : tasmlabel);
- var
- swapped : boolean;
- tmpreg : tregister;
- i : byte;
- tmpl: TAsmLabel;
- begin
- tmpl:=nil;
- if size in [OS_8,OS_S8]then
- begin
- if cmp_op in [OC_EQ,OC_NE,OC_B,OC_AE] then
- begin
- getcpuregister(list,NR_A);
- a_load_reg_reg(list,OS_8,OS_8,reg,NR_A);
- list.concat(taicpu.op_reg_const(A_CP,NR_A,a));
- case cmp_op of
- OC_EQ:
- a_jmp_flags(list,F_E,l);
- OC_NE:
- a_jmp_flags(list,F_NE,l);
- OC_B:
- a_jmp_flags(list,F_C,l);
- OC_AE:
- a_jmp_flags(list,F_NC,l);
- else
- internalerror(2020042206);
- end;
- ungetcpuregister(list,NR_A);
- end
- else if cmp_op in [OC_A,OC_BE] then
- begin
- getcpuregister(list,NR_A);
- a_load_const_reg(list,OS_8,a,NR_A);
- list.concat(taicpu.op_reg_reg(A_CP,NR_A,reg));
- case cmp_op of
- OC_A:
- a_jmp_flags(list,F_C,l);
- OC_BE:
- a_jmp_flags(list,F_NC,l);
- else
- internalerror(2020042218);
- end;
- ungetcpuregister(list,NR_A);
- end
- else if cmp_op in [OC_LT,OC_GTE] then
- begin
- getcpuregister(list,NR_A);
- a_load_reg_reg(list,OS_8,OS_8,reg,NR_A);
- list.concat(taicpu.op_reg_const(A_SUB,NR_A,a));
- current_asmdata.getjumplabel(tmpl);
- a_jmp_flags(list,F_PO,tmpl);
- current_asmdata.CurrAsmList.Concat(taicpu.op_reg_const(A_XOR,NR_A,$80));
- cg.a_label(current_asmdata.CurrAsmList,tmpl);
- case cmp_op of
- OC_LT:
- a_jmp_flags(list,F_M,l);
- OC_GTE:
- a_jmp_flags(list,F_P,l);
- else
- internalerror(2020042219);
- end;
- ungetcpuregister(list,NR_A);
- end
- else if cmp_op in [OC_GT,OC_LTE] then
- begin
- getcpuregister(list,NR_A);
- a_load_const_reg(list,OS_8,a,NR_A);
- list.concat(taicpu.op_reg_reg(A_SUB,NR_A,reg));
- current_asmdata.getjumplabel(tmpl);
- a_jmp_flags(list,F_PO,tmpl);
- current_asmdata.CurrAsmList.Concat(taicpu.op_reg_const(A_XOR,NR_A,$80));
- cg.a_label(current_asmdata.CurrAsmList,tmpl);
- case cmp_op of
- OC_GT:
- a_jmp_flags(list,F_M,l);
- OC_LTE:
- a_jmp_flags(list,F_P,l);
- else
- internalerror(2020042220);
- end;
- ungetcpuregister(list,NR_A);
- end;
- end
- else if cmp_op in [OC_EQ,OC_NE] then
- begin
- if cmp_op=OC_EQ then
- current_asmdata.getjumplabel(tmpl);
- for i:=0 to tcgsize2size[size]-1 do
- begin
- a_load_reg_reg(list,OS_8,OS_8,GetOffsetReg(reg,i),NR_A);
- list.concat(taicpu.op_reg_const(A_CP,NR_A,Byte(a shr (8*i))));
- case cmp_op of
- OC_EQ:
- if i<>(tcgsize2size[size]-1) then
- a_jmp_flags(list,F_NE,tmpl)
- else
- a_jmp_flags(list,F_E,l);
- OC_NE:
- a_jmp_flags(list,F_NE,l);
- else
- internalerror(2020042221);
- end;
- end;
- if cmp_op=OC_EQ then
- cg.a_label(current_asmdata.CurrAsmList,tmpl);
- end
- else if cmp_op in [OC_GT,OC_LT,OC_GTE,OC_LTE,OC_BE,OC_B,OC_AE,OC_A] then
- begin
- getcpuregister(list,NR_A);
- current_asmdata.getjumplabel(tmpl);
- for i:=tcgsize2size[size]-1 downto 0 do
- begin
- a_load_reg_reg(list,OS_8,OS_8,GetOffsetReg(reg,i),NR_A);
- list.concat(taicpu.op_reg_const(A_CP,NR_A,Byte(a shr (8*i))));
- if (i=(tcgsize2size[size]-1)) and (cmp_op in [OC_GT,OC_LT,OC_GTE,OC_LTE]) then
- case cmp_op of
- OC_GTE,
- OC_GT:
- a_jmp_signed_cmp_3way(list,tmpl,nil,l);
- OC_LT,
- OC_LTE:
- a_jmp_signed_cmp_3way(list,l,nil,tmpl);
- else
- internalerror(2020042222);
- end
- else if i<>0 then
- case cmp_op of
- OC_AE,
- OC_A,
- OC_GTE,
- OC_GT:
- a_jmp_unsigned_cmp_3way(list,tmpl,nil,l);
- OC_BE,
- OC_B,
- OC_LT,
- OC_LTE:
- a_jmp_unsigned_cmp_3way(list,l,nil,tmpl);
- else
- internalerror(2020042223);
- end
- else
- case cmp_op of
- OC_A,
- OC_GT:
- a_jmp_unsigned_cmp_3way(list,nil,nil,l);
- OC_B,
- OC_LT:
- a_jmp_unsigned_cmp_3way(list,l,nil,nil);
- OC_AE,
- OC_GTE:
- a_jmp_unsigned_cmp_3way(list,nil,l,l);
- OC_BE,
- OC_LTE:
- a_jmp_unsigned_cmp_3way(list,l,l,nil);
- else
- internalerror(2020042224);
- end;
- end;
- cg.a_label(current_asmdata.CurrAsmList,tmpl);
- ungetcpuregister(list,NR_A);
- end
- else
- internalerror(2020042205);
- end;
- procedure tcgz80.a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel);
- begin
- internalerror(2020042301);
- end;
- procedure tcgz80.a_jmp_name(list : TAsmList;const s : string);
- var
- ai : taicpu;
- begin
- ai:=taicpu.op_sym(A_JRJP,current_asmdata.RefAsmSymbol(s,AT_FUNCTION));
- ai.is_jmp:=true;
- list.concat(ai);
- end;
- procedure tcgz80.a_jmp_always(list : TAsmList;l: tasmlabel);
- var
- ai : taicpu;
- begin
- ai:=taicpu.op_sym(A_JRJP,l);
- ai.is_jmp:=true;
- list.concat(ai);
- end;
- procedure tcgz80.a_jmp_flags(list : TAsmList;const f : TResFlags;l: tasmlabel);
- var
- ai : taicpu;
- begin
- ai:=taicpu.op_cond_sym(A_JRJP,flags_to_cond(f),l);
- ai.is_jmp:=true;
- list.concat(ai);
- end;
- procedure tcgz80.a_jmp_unsigned_cmp_3way(list: TAsmList; onbelow, onequal, onabove: tasmlabel);
- var
- skiplabel: TAsmLabel;
- begin
- if (onbelow= nil) and (onequal= nil) and (onabove= nil) then
- {nothing}
- else if (onbelow= nil) and (onequal= nil) and (onabove<>nil) then
- begin
- current_asmdata.getjumplabel(skiplabel);
- a_jmp_flags(list,F_E,skiplabel);
- a_jmp_flags(list,F_NC,onabove);
- cg.a_label(list,skiplabel);
- end
- else if (onbelow= nil) and (onequal<>nil) and (onabove= nil) then
- a_jmp_flags(list,F_E,onequal)
- else if (onbelow= nil) and (onequal<>nil) and (onabove<>nil) then
- begin
- if onequal<>onabove then
- a_jmp_flags(list,F_E,onequal);
- a_jmp_flags(list,F_NC,onabove);
- end
- else if (onbelow<>nil) and (onequal= nil) and (onabove= nil) then
- a_jmp_flags(list,F_C,onbelow)
- else if (onbelow<>nil) and (onequal= nil) and (onabove<>nil) then
- begin
- if onbelow<>onabove then
- a_jmp_flags(list,F_C,onbelow);
- a_jmp_flags(list,F_NE,onabove);
- end
- else if (onbelow<>nil) and (onequal<>nil) and (onabove= nil) then
- begin
- a_jmp_flags(list,F_C,onbelow);
- a_jmp_flags(list,F_E,onequal);
- end
- else if (onbelow<>nil) and (onequal<>nil) and (onabove<>nil) then
- begin
- if (onbelow=onequal) and (onequal=onabove) then
- a_jmp_always(list,onbelow)
- else if onequal=onabove then
- begin
- a_jmp_flags(list,F_C,onbelow);
- a_jmp_always(list,onabove);
- end
- else if onbelow=onequal then
- begin
- a_jmp_flags(list,F_C,onbelow);
- a_jmp_flags(list,F_E,onequal);
- a_jmp_always(list,onabove);
- end
- else if onbelow=onabove then
- begin
- a_jmp_flags(list,F_E,onequal);
- a_jmp_always(list,onabove);
- end
- else
- begin
- { the generic case - all 3 are different labels }
- a_jmp_flags(list,F_C,onbelow);
- a_jmp_flags(list,F_E,onequal);
- a_jmp_always(list,onabove);
- end;
- end
- else
- begin
- { Shouldn't happen! All possible combinations are handled by the above code. }
- internalerror(2020042201);
- end;
- end;
- procedure tcgz80.a_jmp_signed_cmp_3way(list: TAsmList; onless, onequal, ongreater: tasmlabel);
- var
- l, skiplabel: TAsmLabel;
- begin
- if (onless= nil) and (onequal= nil) and (ongreater= nil) then
- {nothing}
- else if (onless= nil) and (onequal= nil) and (ongreater<>nil) then
- begin
- current_asmdata.getjumplabel(skiplabel);
- a_jmp_flags(list,F_E,skiplabel);
- current_asmdata.getjumplabel(l);
- a_jmp_flags(list,F_PO,l);
- current_asmdata.CurrAsmList.Concat(taicpu.op_reg_const(A_XOR,NR_A,$80));
- cg.a_label(current_asmdata.CurrAsmList,l);
- a_jmp_flags(list,F_P,ongreater);
- cg.a_label(list,skiplabel);
- end
- else if (onless= nil) and (onequal<>nil) and (ongreater= nil) then
- a_jmp_flags(list,F_E,onequal)
- else if (onless= nil) and (onequal<>nil) and (ongreater<>nil) then
- begin
- if onequal<>ongreater then
- a_jmp_flags(list,F_E,onequal);
- current_asmdata.getjumplabel(l);
- a_jmp_flags(list,F_PO,l);
- current_asmdata.CurrAsmList.Concat(taicpu.op_reg_const(A_XOR,NR_A,$80));
- cg.a_label(current_asmdata.CurrAsmList,l);
- a_jmp_flags(list,F_P,ongreater);
- end
- else if (onless<>nil) and (onequal= nil) and (ongreater= nil) then
- begin
- current_asmdata.getjumplabel(l);
- a_jmp_flags(list,F_PO,l);
- current_asmdata.CurrAsmList.Concat(taicpu.op_reg_const(A_XOR,NR_A,$80));
- cg.a_label(current_asmdata.CurrAsmList,l);
- a_jmp_flags(list,F_M,onless);
- end
- else if (onless<>nil) and (onequal= nil) and (ongreater<>nil) then
- begin
- if onless=ongreater then
- a_jmp_flags(list,F_NE,onless)
- else
- begin
- current_asmdata.getjumplabel(skiplabel);
- a_jmp_flags(list,F_E,skiplabel);
- current_asmdata.getjumplabel(l);
- a_jmp_flags(list,F_PO,l);
- current_asmdata.CurrAsmList.Concat(taicpu.op_reg_const(A_XOR,NR_A,$80));
- cg.a_label(current_asmdata.CurrAsmList,l);
- a_jmp_flags(list,F_M,onless);
- a_jmp_always(list,ongreater);
- cg.a_label(list,skiplabel);
- end;
- end
- else if (onless<>nil) and (onequal<>nil) and (ongreater= nil) then
- begin
- a_jmp_flags(list,F_E,onequal);
- current_asmdata.getjumplabel(l);
- a_jmp_flags(list,F_PO,l);
- current_asmdata.CurrAsmList.Concat(taicpu.op_reg_const(A_XOR,NR_A,$80));
- cg.a_label(current_asmdata.CurrAsmList,l);
- a_jmp_flags(list,F_M,onless);
- end
- else if (onless<>nil) and (onequal<>nil) and (ongreater<>nil) then
- begin
- if (onless=onequal) and (onequal=ongreater) then
- a_jmp_always(list,onless)
- else if onequal=ongreater then
- begin
- current_asmdata.getjumplabel(l);
- a_jmp_flags(list,F_PO,l);
- current_asmdata.CurrAsmList.Concat(taicpu.op_reg_const(A_XOR,NR_A,$80));
- cg.a_label(current_asmdata.CurrAsmList,l);
- a_jmp_flags(list,F_M,onless);
- a_jmp_always(list,ongreater);
- end
- else if onless=onequal then
- begin
- a_jmp_flags(list,F_E,onequal);
- current_asmdata.getjumplabel(l);
- a_jmp_flags(list,F_PO,l);
- current_asmdata.CurrAsmList.Concat(taicpu.op_reg_const(A_XOR,NR_A,$80));
- cg.a_label(current_asmdata.CurrAsmList,l);
- a_jmp_flags(list,F_M,onless);
- a_jmp_always(list,ongreater);
- end
- else if onless=ongreater then
- begin
- a_jmp_flags(list,F_E,onequal);
- a_jmp_always(list,ongreater);
- end
- else
- begin
- { the generic case - all 3 are different labels }
- a_jmp_flags(list,F_E,onequal);
- current_asmdata.getjumplabel(l);
- a_jmp_flags(list,F_PO,l);
- current_asmdata.CurrAsmList.Concat(taicpu.op_reg_const(A_XOR,NR_A,$80));
- cg.a_label(current_asmdata.CurrAsmList,l);
- a_jmp_flags(list,F_M,onless);
- a_jmp_always(list,ongreater);
- end;
- end
- else
- begin
- { Shouldn't happen! All possible combinations are handled by the above code. }
- internalerror(2020042204);
- end;
- end;
- procedure tcgz80.g_flags2reg(list: TAsmList; size: TCgSize; const f: TResFlags; reg: TRegister);
- var
- l : TAsmLabel;
- tmpflags : TResFlags;
- begin
- if f in [F_C,F_NC] then
- begin
- a_load_const_reg(list,size,0,reg);
- if f=F_NC then
- list.concat(taicpu.op_none(A_CCF));
- list.concat(taicpu.op_reg(A_RL,reg));
- end
- else
- begin
- current_asmdata.getjumplabel(l);
- a_load_const_reg(list,size,0,reg);
- tmpflags:=f;
- inverse_flags(tmpflags);
- a_jmp_flags(list,tmpflags,l);
- list.concat(taicpu.op_reg(A_INC,reg));
- cg.a_label(list,l);
- end;
- end;
- procedure tcgz80.g_stackpointer_alloc(list: TAsmList; localsize: longint);
- begin
- if localsize>0 then
- begin
- list.Concat(taicpu.op_reg_const(A_LD,NR_HL,-localsize));
- list.Concat(taicpu.op_reg_reg(A_ADD,NR_HL,NR_SP));
- list.Concat(taicpu.op_reg_reg(A_LD,NR_SP,NR_HL));
- end;
- end;
- procedure tcgz80.a_adjust_sp(list : TAsmList; value : longint);
- var
- i : integer;
- sym: TAsmSymbol;
- ref: treference;
- begin
- case value of
- 0:
- ;
- -7..-1:
- begin
- for i:=value to -1 do
- list.concat(taicpu.op_reg(A_DEC,NR_SP));
- end;
- 1..7:
- begin
- for i:=1 to value do
- list.concat(taicpu.op_reg(A_INC,NR_SP));
- end;
- else
- begin
- sym:=current_asmdata.RefAsmSymbol('FPC_Z80_SAVE_HL',AT_DATA);
- reference_reset_symbol(ref,sym,0,1,[]);
- // block interrupts
- list.concat(taicpu.op_none(A_DI));
- // save HL
- list.concat(taicpu.op_ref_reg(A_LD,ref,NR_HL));
- // adjust SP
- list.concat(taicpu.op_reg_const(A_LD,NR_HL,value));
- list.concat(taicpu.op_reg_reg(A_ADD,NR_HL,NR_SP));
- list.concat(taicpu.op_reg_reg(A_LD,NR_SP,NR_HL));
- // restore HL
- list.concat(taicpu.op_reg_ref(A_LD,NR_HL,ref));
- // release interrupts
- list.concat(taicpu.op_none(A_EI));
- end;
- end;
- end;
- procedure tcgz80.g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean);
- var
- regsize,stackmisalignment: longint;
- begin
- regsize:=0;
- stackmisalignment:=0;
- { save old framepointer }
- if not nostackframe then
- begin
- { return address }
- inc(stackmisalignment,2);
- list.concat(tai_regalloc.alloc(current_procinfo.framepointer,nil));
- if current_procinfo.framepointer=NR_FRAME_POINTER_REG then
- begin
- { push <frame_pointer> }
- inc(stackmisalignment,2);
- include(rg[R_INTREGISTER].preserved_by_proc,RS_FRAME_POINTER_REG);
- list.concat(Taicpu.op_reg(A_PUSH,NR_FRAME_POINTER_REG));
- { Return address and FP are both on stack }
- current_asmdata.asmcfi.cfa_def_cfa_offset(list,2*2);
- current_asmdata.asmcfi.cfa_offset(list,NR_FRAME_POINTER_REG,-(2*2));
- if current_procinfo.procdef.proctypeoption<>potype_exceptfilter then
- begin
- list.concat(Taicpu.op_reg_const(A_LD,NR_FRAME_POINTER_REG,0));
- list.concat(Taicpu.op_reg_reg(A_ADD,NR_FRAME_POINTER_REG,NR_STACK_POINTER_REG))
- end
- else
- begin
- internalerror(2020040301);
- (*push_regs;
- gen_load_frame_for_exceptfilter(list);
- { Need only as much stack space as necessary to do the calls.
- Exception filters don't have own local vars, and temps are 'mapped'
- to the parent procedure.
- maxpushedparasize is already aligned at least on x86_64. }
- localsize:=current_procinfo.maxpushedparasize;*)
- end;
- current_asmdata.asmcfi.cfa_def_cfa_register(list,NR_FRAME_POINTER_REG);
- end
- else
- begin
- CGmessage(cg_d_stackframe_omited);
- end;
- { allocate stackframe space }
- if (localsize<>0) or
- ((target_info.stackalign>sizeof(pint)) and
- (stackmisalignment <> 0) and
- ((pi_do_call in current_procinfo.flags) or
- (po_assembler in current_procinfo.procdef.procoptions))) then
- begin
- if target_info.stackalign>sizeof(pint) then
- localsize := align(localsize+stackmisalignment,target_info.stackalign)-stackmisalignment;
- g_stackpointer_alloc(list,localsize);
- if current_procinfo.framepointer=NR_STACK_POINTER_REG then
- current_asmdata.asmcfi.cfa_def_cfa_offset(list,regsize+localsize+sizeof(pint));
- current_procinfo.final_localsize:=localsize;
- end
- end;
- end;
- procedure tcgz80.g_proc_exit(list : TAsmList;parasize : longint;nostackframe:boolean);
- var
- regs : tcpuregisterset;
- reg : TSuperRegister;
- LocalSize : longint;
- stacksize : longint;
- begin
- { every byte counts for Z80, so if a subroutine is marked as non-returning, we do
- not generate any exit code, so we really trust the noreturn directive
- }
- if po_noreturn in current_procinfo.procdef.procoptions then
- exit;
- { remove stackframe }
- if not nostackframe then
- begin
- stacksize:=current_procinfo.calc_stackframe_size;
- if (target_info.stackalign>4) and
- ((stacksize <> 0) or
- (pi_do_call in current_procinfo.flags) or
- { can't detect if a call in this case -> use nostackframe }
- { if you (think you) know what you are doing }
- (po_assembler in current_procinfo.procdef.procoptions)) then
- stacksize := align(stacksize+sizeof(aint),target_info.stackalign) - sizeof(aint);
- if (current_procinfo.framepointer=NR_STACK_POINTER_REG) then
- begin
- if stacksize<>0 then
- a_adjust_sp(list,stacksize);
- end
- else
- begin
- list.Concat(taicpu.op_reg_reg(A_LD,NR_STACK_POINTER_REG,NR_FRAME_POINTER_REG));
- list.Concat(taicpu.op_reg(A_POP,NR_FRAME_POINTER_REG));
- end;
- list.concat(tai_regalloc.dealloc(current_procinfo.framepointer,nil));
- end;
- list.concat(taicpu.op_none(A_RET));
- end;
- procedure tcgz80.a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);
- var
- tmpref : treference;
- begin
- if assigned(ref.symbol) then
- begin
- reference_reset(tmpref,0,[]);
- tmpref.symbol:=ref.symbol;
- tmpref.offset:=ref.offset;
- tmpref.refaddr:=addr_lo8;
- list.concat(taicpu.op_reg_ref(A_LD,r,tmpref));
- tmpref.refaddr:=addr_hi8;
- list.concat(taicpu.op_reg_ref(A_LD,GetNextReg(r),tmpref));
- if (ref.base<>NR_NO) then
- a_op_reg_reg(list,OP_ADD,OS_16,ref.base,r);
- if (ref.index<>NR_NO) then
- a_op_reg_reg(list,OP_ADD,OS_16,ref.index,r);
- end
- else if ref.base=NR_IX then
- begin
- list.concat(taicpu.op_reg(A_PUSH,NR_IX));
- getcpuregister(list,NR_H);
- getcpuregister(list,NR_L);
- list.concat(taicpu.op_reg(A_POP,NR_HL));
- emit_mov(list,r,NR_L);
- ungetcpuregister(list,NR_L);
- emit_mov(list,GetNextReg(r),NR_H);
- ungetcpuregister(list,NR_H);
- if (ref.index<>NR_NO) then
- a_op_reg_reg(list,OP_ADD,OS_16,ref.index,r);
- if ref.offset<>0 then
- a_op_const_reg(list,OP_ADD,OS_16,ref.offset,r);
- end
- else if (ref.base=NR_SP) or (ref.base=NR_BC) or (ref.base=NR_DE) then
- begin
- getcpuregister(list,NR_H);
- getcpuregister(list,NR_L);
- list.Concat(taicpu.op_reg_const(A_LD,NR_HL,ref.offset));
- list.Concat(taicpu.op_reg_reg(A_ADD,NR_HL,ref.base));
- emit_mov(list,r,NR_L);
- ungetcpuregister(list,NR_L);
- emit_mov(list,GetNextReg(r),NR_H);
- ungetcpuregister(list,NR_H);
- if (ref.index<>NR_NO) then
- a_op_reg_reg(list,OP_ADD,OS_16,ref.index,r);
- end
- else if ref.base<>NR_NO then
- begin
- a_op_const_reg_reg(list,OP_ADD,OS_16,ref.offset,ref.base,r);
- if (ref.index<>NR_NO) then
- a_op_reg_reg(list,OP_ADD,OS_16,ref.index,r);
- end
- else if ref.index<>NR_NO then
- a_op_const_reg_reg(list,OP_ADD,OS_16,ref.offset,ref.index,r)
- else
- a_load_const_reg(list,OS_16,ref.offset,r);
- end;
- procedure tcgz80.g_concatcopy(list : TAsmList;const source,dest : treference;len : tcgint);
- var
- tmpreg,srcreg,dstreg: tregister;
- srcref,dstref : treference;
- i: Integer;
- begin
- if (len<=2) and
- is_ref_in_opertypes(source,[OT_REF_IX_d,OT_REF_IY_d,OT_REF_HL]) and
- is_ref_in_opertypes(dest,[OT_REF_IX_d,OT_REF_IY_d,OT_REF_HL]) then
- begin
- srcref:=source;
- dstref:=dest;
- tmpreg:=getintregister(list,OS_8);
- for i:=1 to len do
- begin
- list.concat(taicpu.op_reg_ref(A_LD,tmpreg,srcref));
- list.concat(taicpu.op_ref_reg(A_LD,dstref,tmpreg));
- if i<>len then
- begin
- adjust_normalized_ref(list,srcref,1);
- adjust_normalized_ref(list,dstref,1);
- end;
- end;
- end
- else
- begin
- srcreg:=getintregister(list,OS_16);
- a_loadaddr_ref_reg(list,source,srcreg);
- dstreg:=getintregister(list,OS_16);
- a_loadaddr_ref_reg(list,dest,dstreg);
- getcpuregister(list,NR_L);
- a_load_reg_reg(list,OS_8,OS_8,srcreg,NR_L);
- getcpuregister(list,NR_H);
- a_load_reg_reg(list,OS_8,OS_8,GetNextReg(srcreg),NR_H);
- getcpuregister(list,NR_E);
- a_load_reg_reg(list,OS_8,OS_8,dstreg,NR_E);
- getcpuregister(list,NR_D);
- a_load_reg_reg(list,OS_8,OS_8,GetNextReg(dstreg),NR_D);
- getcpuregister(list,NR_B);
- getcpuregister(list,NR_C);
- list.concat(taicpu.op_reg_const(A_LD,NR_BC,len));
- list.concat(taicpu.op_none(A_LDIR));
- ungetcpuregister(list,NR_B);
- ungetcpuregister(list,NR_C);
- ungetcpuregister(list,NR_D);
- ungetcpuregister(list,NR_E);
- ungetcpuregister(list,NR_H);
- ungetcpuregister(list,NR_L);
- end;
- end;
- procedure tcgz80.g_overflowcheck(list: TAsmList; const l: tlocation; def: tdef);
- var
- hl : tasmlabel;
- ai : taicpu;
- cond : TAsmCond;
- begin
- list.Concat(tai_comment.Create(strpnew('WARNING! not implemented: g_overflowCheck')));
- //if not(cs_check_overflow in current_settings.localswitches) then
- // exit;
- //current_asmdata.getjumplabel(hl);
- //if not ((def.typ=pointerdef) or
- // ((def.typ=orddef) and
- // (torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,
- // pasbool8,pasbool16,pasbool32,pasbool64]))) then
- // cond:=C_VC
- //else
- // cond:=C_CC;
- //ai:=Taicpu.Op_Sym(A_BRxx,hl);
- //ai.SetCondition(cond);
- //ai.is_jmp:=true;
- //list.concat(ai);
- //
- //a_call_name(list,'FPC_OVERFLOW',false);
- //a_label(list,hl);
- end;
- procedure tcgz80.g_save_registers(list: TAsmList);
- begin
- { this is done by the entry code }
- end;
- procedure tcgz80.g_restore_registers(list: TAsmList);
- begin
- { this is done by the exit code }
- end;
- procedure tcgz80.a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel);
- begin
- case cond of
- OC_EQ:
- a_jmp_unsigned_cmp_3way(list,nil,l,nil);
- OC_NE:
- a_jmp_unsigned_cmp_3way(list,l,nil,l);
- OC_A:
- a_jmp_unsigned_cmp_3way(list,nil,nil,l);
- OC_B:
- a_jmp_unsigned_cmp_3way(list,l,nil,nil);
- OC_AE:
- a_jmp_unsigned_cmp_3way(list,nil,l,l);
- OC_BE:
- a_jmp_unsigned_cmp_3way(list,l,l,nil);
- OC_GT:
- a_jmp_signed_cmp_3way(list,nil,nil,l);
- OC_LT:
- a_jmp_signed_cmp_3way(list,l,nil,nil);
- OC_GTE:
- a_jmp_signed_cmp_3way(list,nil,l,l);
- OC_LTE:
- a_jmp_signed_cmp_3way(list,l,l,nil);
- else
- internalerror(2011082501);
- end;
- end;
- procedure tcgz80.emit_mov(list: TAsmList;reg2: tregister; reg1: tregister);
- var
- instr: taicpu;
- begin
- instr:=taicpu.op_reg_reg(A_LD,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;
- procedure tcg64fz80.a_op64_reg_reg(list : TAsmList;op:TOpCG;size : tcgsize;regsrc,regdst : tregister64);
- begin
- if not(size in [OS_S64,OS_64]) then
- internalerror(2012102402);
- tcgz80(cg).a_op_reg_reg_internal(list,Op,size,regsrc.reglo,regsrc.reghi,regdst.reglo,regdst.reghi);
- end;
- procedure tcg64fz80.a_op64_const_reg(list : TAsmList;op:TOpCG;size : tcgsize;value : int64;reg : tregister64);
- begin
- tcgz80(cg).a_op_const_reg_internal(list,Op,size,value,reg.reglo,reg.reghi);
- end;
- procedure create_codegen;
- begin
- cg:=tcgz80.create;
- cg64:=tcg64fz80.create;
- end;
- end.
|