paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-21 10:10:19 +02:00
Code Issues Packages Projects Releases Wiki Activity

* started to get some Z80 things working

Browse Source 
git-svn-id: branches/z80@44284 -
This commit is contained in:
florian 2020-03-08 11:43:38 +00:00
parent 1e3901c298
commit 9a4ff8daa4
4 changed files with 68 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
compiler/cgobj.pas
View File

@ -297,6 +297,7 @@ unit cgobj;
procedure a_op_ref_reg(list : TAsmList; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister); virtual; procedure a_op_ref_reg(list : TAsmList; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister); virtual;
procedure a_op_reg_loc(list : TAsmList; Op: TOpCG; reg: tregister; const loc: tlocation); procedure a_op_reg_loc(list : TAsmList; Op: TOpCG; reg: tregister; const loc: tlocation);
procedure a_op_ref_loc(list : TAsmList; Op: TOpCG; const ref: TReference; const loc: tlocation); procedure a_op_ref_loc(list : TAsmList; Op: TOpCG; const ref: TReference; const loc: tlocation);
procedure a_op_loc_reg(list : TAsmList; Op: TOpCG; const loc: tlocation; reg: tregister);
{ trinary operations for processors that support them, 'emulated' } { trinary operations for processors that support them, 'emulated' }
{ on others. None with "ref" arguments since I don't think there } { on others. None with "ref" arguments since I don't think there }
@ -640,7 +641,8 @@ implementation
end; end;
function Tcg.makeregsize(list:TAsmList;reg:Tregister;size:Tcgsize):Tregister; function tcg.makeregsize(list : TAsmList; reg : Tregister; size : Tcgsize
) : Tregister;
var var
subreg:Tsubregister; subreg:Tsubregister;
begin begin
@ -1741,10 +1743,8 @@ implementation
procedure tcg.a_op_ref_loc(list : TAsmList; Op: TOpCG; const ref: TReference; const loc: tlocation); procedure tcg.a_op_ref_loc(list : TAsmList; Op: TOpCG; const ref: TReference; const loc: tlocation);
var var
tmpreg: tregister; tmpreg: tregister;
begin begin
case loc.loc of case loc.loc of
LOC_REGISTER,LOC_CREGISTER: LOC_REGISTER,LOC_CREGISTER:
@ -1761,8 +1761,22 @@ implementation
end; end;
procedure Tcg.a_op_const_reg_reg(list:TAsmList;op:Topcg;size:Tcgsize; procedure tcg.a_op_loc_reg(list : TAsmList; Op : TOpCG;
a:tcgint;src,dst:Tregister); const loc : tlocation; reg : tregister);
begin
case loc.loc of
LOC_REGISTER,LOC_CREGISTER:
a_op_reg_reg(list,op,loc.size,loc.register,reg);
LOC_REFERENCE,LOC_CREFERENCE:
a_op_ref_reg(list,op,loc.size,loc.reference,reg);
else
internalerror(2019020903);
end;
end;
procedure tcg.a_op_const_reg_reg(list : TAsmList; op : TOpCg;
size : tcgsize; a : tcgint; src,dst : tregister);
begin begin
optimize_op_const(size, op, a); optimize_op_const(size, op, a);
case op of case op of
@ -2095,7 +2109,8 @@ implementation
end; end;
procedure tcg.a_loadmm_intreg_reg(list: tasmlist; fromsize,tosize: tcgsize; intreg,mmreg: tregister; shuffle: pmmshuffle); procedure tcg.a_loadmm_intreg_reg(list : TAsmList; fromsize,
tosize : tcgsize; intreg,mmreg : tregister; shuffle : pmmshuffle);
var var
tmpref: treference; tmpref: treference;
begin begin
@ -2109,7 +2124,8 @@ implementation
end; end;
procedure tcg.a_loadmm_reg_intreg(list: tasmlist; fromsize,tosize: tcgsize; mmreg,intreg: tregister; shuffle: pmmshuffle); procedure tcg.a_loadmm_reg_intreg(list : TAsmList; fromsize,
tosize : tcgsize; mmreg,intreg : tregister; shuffle : pmmshuffle);
var var
tmpref: treference; tmpref: treference;
begin begin
@ -2477,7 +2493,8 @@ implementation
end; end;
procedure tcg.a_mul_reg_reg_pair(list: TAsmList; size: TCgSize; src1,src2,dstlo,dsthi: TRegister); procedure tcg.a_mul_reg_reg_pair(list : TAsmList; size : tcgsize; src1,src2,
dstlo,dsthi : TRegister);
begin begin
internalerror(2014060801); internalerror(2014060801);
end; end;

30
compiler/z80/cgcpu.pas
View File

@ -112,6 +112,8 @@ unit cgcpu;
procedure a_op64_const_reg(list : TAsmList;op:TOpCG;size : tcgsize;value : int64;reg : tregister64);override; procedure a_op64_const_reg(list : TAsmList;op:TOpCG;size : tcgsize;value : int64;reg : tregister64);override;
end; end;
function GetByteLoc(const loc : tlocation;nr : byte) : tlocation;
procedure create_codegen; procedure create_codegen;
const const
@ -2187,6 +2189,34 @@ unit cgcpu;
end; end;
function GetByteLoc(const loc : tlocation; nr : byte) : tlocation;
var
i : Integer;
begin
Result:=loc;
Result.size:=OS_8;
case loc.loc of
LOC_REFERENCE,LOC_CREFERENCE:
inc(Result.reference.offset,nr);
LOC_REGISTER,LOC_CREGISTER:
begin
if nr>=4 then
Result.register:=Result.register64.reghi;
nr:=nr mod 4;
for i:=1 to nr do
Result.register:=GetNextReg(Result.register);
end;
LOC_CONSTANT:
if loc.size in [OS_64,OS_S64] then
Result.value:=(Result.value64 shr (nr*8)) and $ff
else
Result.value:=(Result.value shr (nr*8)) and $ff;
else
Internalerror(2019020902);
end;
end;
procedure create_codegen; procedure create_codegen;
begin begin
cg:=tcgz80.create; cg:=tcgz80.create;

7
compiler/z80/cpupara.pas
View File

@ -204,7 +204,8 @@ unit cpupara;
begin begin
{ In case of po_delphi_nested_cc, the parent frame pointer { In case of po_delphi_nested_cc, the parent frame pointer
is always passed on the stack. } is always passed on the stack. }
if (nextintreg<>RS_HL) and if false and { no fastcall yet }
(nextintreg=RS_HL) and
(not(vo_is_parentfp in hp.varoptions) or (not(vo_is_parentfp in hp.varoptions) or
not(po_delphi_nested_cc in p.procoptions)) then not(po_delphi_nested_cc in p.procoptions)) then
begin begin
@ -345,7 +346,7 @@ unit cpupara;
inc(nextintreg); inc(nextintreg);
end end
else else
{ parameters are always passed completely in registers or in memory on avr } { parameters are always passed completely in registers or in memory on Z80 }
internalerror(2015041002); internalerror(2015041002);
dec(paralen,tcgsize2size[paraloc^.size]); dec(paralen,tcgsize2size[paraloc^.size]);
end; end;
@ -365,7 +366,7 @@ unit cpupara;
paraloc^.reference.offset:=stack_offset; paraloc^.reference.offset:=stack_offset;
inc(stack_offset,hp.vardef.size); inc(stack_offset,hp.vardef.size);
end; end;
dec(paralen,hp.vardef.size); paralen:=0;
end; end;
else else
internalerror(2002071002); internalerror(2002071002);

38
compiler/z80/nz80add.pas
View File

@ -187,35 +187,15 @@ interface
tmpreg1,tmpreg2 : tregister; tmpreg1,tmpreg2 : tregister;
i : longint; i : longint;
begin begin
//pass_left_right; pass_left_right;
//force_reg_left_right(true,true); // force_reg_left_right(true,true);
//
//unsigned:=not(is_signed(left.resultdef)) or unsigned:=not(is_signed(left.resultdef)) or
// not(is_signed(right.resultdef)); not(is_signed(right.resultdef));
//
//if getresflags(unsigned)=F_NotPossible then cg.a_load_loc_reg(current_asmdata.CurrAsmList,OS_8,GetByteLoc(left.location,0),NR_A);
// begin cg.a_op_loc_reg(current_asmdata.CurrAsmList,OP_SUB,GetByteLoc(right.location,0),NR_A);
// swapleftright;
// { if we have to swap back and left is a constant, force it to a register because we cannot generate
// the needed code using a constant }
// if (left.location.loc=LOC_CONSTANT) and (left.location.value<>0) then
// hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,false);
// end;
//
//if right.location.loc=LOC_CONSTANT then
// begin
// { decrease register pressure on registers >= r16 }
// if (right.location.value and $ff)=0 then
// current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CP,left.location.register,NR_R1))
// else
// current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_CPI,left.location.register,right.location.value and $ff))
// end
//{ on the left side, we allow only a constant if it is 0 }
//else if (left.location.loc=LOC_CONSTANT) and (left.location.value=0) then
// current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CP,NR_R1,right.location.register))
//else
// current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CP,left.location.register,right.location.register));
//
//tmpreg1:=left.location.register; //tmpreg1:=left.location.register;
//tmpreg2:=right.location.register; //tmpreg2:=right.location.register;
// //