paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-20 15:32:06 +02:00
Code Issues Packages Projects Releases Wiki Activity

* several additions, almost complete (only some problems with resflags left)

Browse Source
This commit is contained in:
Jonas Maebe 2001-09-28 20:40:05 +00:00
parent b374bec6fb
commit fa0a56f559
2 changed files with 105 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

148
compiler/powerpc/cgcpu.pas
View File

@ -34,42 +34,42 @@ unit cgcpu;
{ left to right), this allows to move the parameter to } { left to right), this allows to move the parameter to }
{ register, if the cpu supports register calling } { register, if the cpu supports register calling }
{ conventions } { conventions }
procedure a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;nr : longint);virtual; procedure a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;nr : longint);override;
procedure a_param_const(list : taasmoutput;size : tcgsize;a : aword;nr : longint);virtual; procedure a_param_const(list : taasmoutput;size : tcgsize;a : aword;nr : longint);override;
procedure a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;nr : longint);virtual; procedure a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;nr : longint);override;
procedure a_paramaddr_ref(list : taasmoutput;const r : treference;nr : longint);virtual; procedure a_paramaddr_ref(list : taasmoutput;const r : treference;nr : longint);override;
procedure a_call_name(list : taasmoutput;const s : string; procedure a_call_name(list : taasmoutput;const s : string;
offset : longint);virtual; offset : longint);override;
procedure a_op_const_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; reg: TRegister); virtual; procedure a_op_const_reg(list : taasmoutput; Op: TOpCG; a: AWord; reg: TRegister); override;
procedure a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; reg1, reg2: TRegister); virtual; procedure a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; src, dst: TRegister); override;
{ move instructions } { move instructions }
procedure a_load_const_reg(list : taasmoutput; size: tcgsize; a : aword;reg : tregister);virtual; procedure a_load_const_reg(list : taasmoutput; size: tcgsize; a : aword;reg : tregister);override;
procedure a_load_reg_ref(list : taasmoutput; size: tcgsize; reg : tregister;const ref2 : treference);virtual; procedure a_load_reg_ref(list : taasmoutput; size: tcgsize; reg : tregister;const ref : treference);override;
procedure a_load_ref_reg(list : taasmoutput;size : tcgsize;const Ref2 : treference;reg : tregister);virtual; procedure a_load_ref_reg(list : taasmoutput;size : tcgsize;const Ref : treference;reg : tregister);override;
procedure a_load_reg_reg(list : taasmoutput;size : tcgsize;reg1,reg2 : tregister);virtual; procedure a_load_reg_reg(list : taasmoutput;size : tcgsize;reg1,reg2 : tregister);override;
{ comparison operations } { comparison operations }
procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister; procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
l : pasmlabel);virtual; l : pasmlabel);override;
procedure a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : pasmlabel); procedure a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : pasmlabel);
procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: pasmlabel); procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: pasmlabel);
procedure g_flags2reg(const f: TAsmCond; reg: TRegister); abstract; procedure g_flags2reg(list: taasmoutput; const f: TAsmCond; reg: TRegister); override;
procedure g_stackframe_entry_sysv(list : taasmoutput;localsize : longint); procedure g_stackframe_entry_sysv(list : taasmoutput;localsize : longint);
procedure g_stackframe_entry_mac(list : taasmoutput;localsize : longint); procedure g_stackframe_entry_mac(list : taasmoutput;localsize : longint);
procedure g_stackframe_entry(list : taasmoutput;localsize : longint);virtual; procedure g_stackframe_entry(list : taasmoutput;localsize : longint);override;
procedure g_restore_frame_pointer(list : taasmoutput);virtual; procedure g_restore_frame_pointer(list : taasmoutput);override;
procedure g_return_from_proc(list : taasmoutput;parasize : aword); virtual; procedure g_return_from_proc(list : taasmoutput;parasize : aword); override;
procedure a_loadaddress_ref_reg(list : taasmoutput;const ref2 : treference;r : tregister);virtual; procedure a_loadaddress_ref_reg(list : taasmoutput;const ref2 : treference;r : tregister);override;
procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword; delsource,loadref : boolean);virtual; procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword; delsource,loadref : boolean);override;
private private
@ -115,10 +115,16 @@ const
TOpCmp2AsmCond: Array[topcmp] of TAsmCondFlags = (CF_NONE,CF_EQ,CF_GT, TOpCmp2AsmCond: Array[topcmp] of TAsmCondFlags = (CF_NONE,CF_EQ,CF_GT,
CF_LT,CF_GE,CF_LE,CF_NE,CF_LE,CF_NG,CF_GE,CF_NL); CF_LT,CF_GE,CF_LE,CF_NE,CF_LE,CF_NG,CF_GE,CF_NL);
LoadInstr: Array[OS_8..OS_32,boolean, boolean] of TAsmOp = LoadInstr: Array[OS_8..OS_S32,boolean, boolean] of TAsmOp =
{ indexed? updating?} { indexed? updating?}
(((A_LBZ,A_LBZU),(A_LBZX,A_LBZUX)), (((A_LBZ,A_LBZU),(A_LBZX,A_LBZUX)),
((A_LHZ,A_LHZU),(A_LHZX,A_LHZUX)), ((A_LHZ,A_LHZU),(A_LHZX,A_LHZUX)),
((A_LWZ,A_LWZU),(A_LWZX,A_LWZUX)),
{ 64bit stuff should be handled separately }
((A_NONE,A_NONE),(A_NONE,A_NONE)),
{ there's no load-byte-with-sign-extend :( }
((A_LBZ,A_LBZU),(A_LBZX,A_LBZUX)),
((A_LHA,A_LHAU),(A_LHAX,A_LHAUX)),
((A_LWZ,A_LWZU),(A_LWZX,A_LWZUX))); ((A_LWZ,A_LWZU),(A_LWZX,A_LWZUX)));
StoreInstr: Array[OS_8..OS_32,boolean, boolean] of TAsmOp = StoreInstr: Array[OS_8..OS_32,boolean, boolean] of TAsmOp =
@ -243,42 +249,58 @@ const
procedure tcgppc.a_load_const_reg(list : taasmoutput; size: TCGSize; a : aword; reg : TRegister); procedure tcgppc.a_load_const_reg(list : taasmoutput; size: TCGSize; a : aword; reg : TRegister);
begin begin
If (a and $ffff) <> 0 Then if (a and $ffff) <> 0 Then
Begin begin
list.concat(taicpu.op_reg_const(A_LI,reg,a and $ffff)); list.concat(taicpu.op_reg_const(A_LI,reg,a and $ffff));
If (a shr 16) <> 0 Then if (longint(a) < low(smallint)) or
(longint(a) > high(smallint)) then
list.concat(taicpu.op_reg_const(A_ADDIS,reg, list.concat(taicpu.op_reg_const(A_ADDIS,reg,
(a shr 16)+ord(smallint(a and $ffff) < 0))) (a shr 16)+ord(smallint(a and $ffff) < 0)))
End end
Else else
list.concat(taicpu.op_reg_const(A_LIS,reg,a shr 16)); list.concat(taicpu.op_reg_const(A_LIS,reg,a shr 16));
end; end;
procedure tcgppc.a_load_reg_ref(list : taasmoutput; size: TCGSize; reg : tregister;const ref2 : treference); procedure tcgppc.a_load_reg_ref(list : taasmoutput; size: TCGSize; reg : tregister;const ref : treference);
var var
op: TAsmOp; op: TAsmOp;
ref: TReference; ref2: TReference;
begin begin
ref := ref2; ref2 := ref;
FixRef(ref); FixRef(ref2);
op := storeinstr[size,ref.index<>R_NO,false]; if size in [OS_S8..OS_S16] then
a_load_store(list,op,reg,ref); { storing is the same for signed and unsigned values }
size := tcgsize(ord(size)-(ord(OS_S8)-ord(OS_8)));
{ 64 bit stuff should be handled separately }
if size = OS_64 then
internalerror(200109236);
op := storeinstr[size,ref2.index<>R_NO,false];
a_load_store(list,op,reg,ref2);
End; End;
procedure tcgppc.a_load_ref_reg(list : taasmoutput;size : tcgsize;const ref2: treference;reg : tregister); procedure tcgppc.a_load_ref_reg(list : taasmoutput;size : tcgsize;const ref: treference;reg : tregister);
var var
op: TAsmOp; op: tasmop;
tmpreg: tregister; tmpreg: tregister;
ref, tmpref: TReference; ref2, tmpref: treference;
begin begin
ref := ref2; if ref.is_immediate then
FixRef(ref); a_load_const_reg(list,size,ref.offset,reg)
op := loadinstr[size,ref.index<>R_NO,false]; else
a_load_store(list,op,reg,ref); begin
ref2 := ref;
fixref(ref2);
op := loadinstr[size,ref2.index<>R_NO,false];
a_load_store(list,op,reg,ref2);
{ sign extend shortint if necessary, since there is no }
{ load instruction that does that automatically (JM) }
if size = OS_S8 then
list.concat(taicpu.op_reg_reg(A_EXTSB,reg,reg));
end;
end; end;
procedure tcgppc.a_load_reg_reg(list : taasmoutput;size : tcgsize;reg1,reg2 : tregister); procedure tcgppc.a_load_reg_reg(list : taasmoutput;size : tcgsize;reg1,reg2 : tregister);
@ -287,7 +309,7 @@ const
list.concat(taicpu.op_reg_reg(A_MR,reg2,reg1)); list.concat(taicpu.op_reg_reg(A_MR,reg2,reg1));
end; end;
procedure tcgppc.a_op_const_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; reg: TRegister); procedure tcgppc.a_op_const_reg(list : taasmoutput; Op: TOpCG; a: AWord; reg: TRegister);
var var
scratch_register: TRegister; scratch_register: TRegister;
@ -320,10 +342,10 @@ const
end; end;
end; end;
procedure tcgppc.a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; reg1, reg2: TRegister); procedure tcgppc.a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; src, dst: TRegister);
begin begin
a_op_reg_reg_reg(list,op,reg2,reg1,reg2); a_op_reg_reg_reg(list,op,dst,src,dst);
end; end;
{*************** compare instructructions ****************} {*************** compare instructructions ****************}
@ -848,18 +870,17 @@ const
useReg: boolean; useReg: boolean;
begin begin
useReg := false;
ophi := TOpCG2AsmOpConstHi[op]; ophi := TOpCG2AsmOpConstHi[op];
oplo := TOpCG2AsmOpConstLo[op]; oplo := TOpCG2AsmOpConstLo[op];
{ constants in a PPC instruction are always interpreted as signed } { constants in a PPC instruction are always interpreted as signed }
{ 16bit values, so if the value is between low(smallint) and } { 16bit values, so if the value is between low(smallint) and }
{ high(smallint), it's easy } { high(smallint), it's easy }
if (longint(a) >= low(smallint)) and if (longint(a) >= low(smallint)) and
(longint(a) <= high(smallint)) then (longint(a) <= high(smallint)) then
begin begin
list.concat(taicpu.op_reg_reg_const(oplo,reg1,reg2,a)); list.concat(taicpu.op_reg_reg_const(oplo,reg1,reg2,a));
exit; exit;
end; end;
{ all basic constant instructions also have a shifted form that } { all basic constant instructions also have a shifted form that }
{ works only on the highest 16bits, so if low(a) is 0, we can } { works only on the highest 16bits, so if low(a) is 0, we can }
{ use that one } { use that one }
@ -868,8 +889,9 @@ const
list.concat(taicpu.op_reg_reg(ophi,reg1,reg2,high(a))); list.concat(taicpu.op_reg_reg(ophi,reg1,reg2,high(a)));
exit; exit;
end; end;
{ otherwise, the instructinos we can generate depend on the } { otherwise, the instructions we can generate depend on the }
{ operation } { operation }
useReg := false;
case op of case op of
OP_ADD,OP_SUB: OP_ADD,OP_SUB:
begin begin
@ -880,8 +902,15 @@ const
OP_OR: OP_OR:
{ try to use rlwimi } { try to use rlwimi }
if get_rlwi_const then if get_rlwi_const then
list.concat(taicpu.op_reg_reg_const_const_const(A_RLWIMI,reg1, begin
reg2,0,l1,l2)) if reg1 <> reg2 then
list.concat(taicpu.op_reg_reg(A_MR,reg1,reg2));
scratch_reg := get_scratch_reg(list);
list.concat(taicpu.op_reg_const(A_LI,scratch_reg,-1));
list.concat(taicpu.op_reg_reg_const_const_const(A_RLWIMI,reg1,
reg2,0,l1,l2));
free_scratch_reg(list,scratch_reg);
end
else else
useReg := true; useReg := true;
OP_AND: OP_AND:
@ -961,22 +990,25 @@ const
p: paicpu; p: paicpu;
begin begin
p := taicpu.op_sym(op,newasmsymbol(l^.name)); p := taicpu.op_sym(op,newasmsymbol(l.name));
create_cond_norm(c,0,p^.condition); create_cond_norm(c,0,p.condition);
list.concat(p) list.concat(p)
end; end;
end. end.
{ {
$Log$ $Log$
Revision 1.5 2001-09-16 10:33:21 jonas Revision 1.6 2001-09-28 20:40:05 jonas
* several additions, almost complete (only some problems with resflags left)
Revision 1.5 2001/09/16 10:33:21 jonas
* some fixes to operations with constants * some fixes to operations with constants
Revision 1.3 2001/09/06 15:25:55 jonas Revision 1.3 2001/09/06 15:25:55 jonas
* changed type of tcg from object to class -> abstract methods are now * changed type of tcg from object to class -> abstract methods are now
a lot cleaner :) a lot cleaner :)
+ more updates: load_*_loc methods, op_*_* methods, g_flags2reg method + more updates: load_*_loc methods, op_*_* methods, g_flags2reg method
(if possible with geenric implementation and necessary ppc (if possible with generic implementation and necessary ppc
implementations) implementations)
* worked a bit further on cgflw, now working on exitnode * worked a bit further on cgflw, now working on exitnode

20
compiler/powerpc/cpubase.pas
View File

@ -113,7 +113,7 @@ type
a_srwi, a_srwi_, a_clrlwi, a_clrlwi_, a_clrrwi, a_clrrwi_, a_clrslwi, a_srwi, a_srwi_, a_clrlwi, a_clrlwi_, a_clrrwi, a_clrrwi_, a_clrslwi,
a_clrslwi_, a_blr, a_bctr, a_blrl, a_bctrl, a_crset, a_crclr, a_crmove, a_clrslwi_, a_blr, a_bctr, a_blrl, a_bctrl, a_crset, a_crclr, a_crmove,
a_crnot, a_mt {move to special prupose reg}, a_mf {move from special purpose reg}, a_crnot, a_mt {move to special prupose reg}, a_mf {move from special purpose reg},
a_nop, a_li, a_lis, a_la, a_mr, a_not, a_mtcr); a_nop, a_li, a_lis, a_la, a_mr, a_mr_, a_not, a_mtcr);
op2strtable=array[tasmop] of string[8]; op2strtable=array[tasmop] of string[8];
@ -260,13 +260,18 @@ const
*****************************************************************************} *****************************************************************************}
type type
TResFlags = (F_LT,F_GT,F_EQ,F_SO,F_FX,F_FEX,F_VX,F_OX); TResFlagsEnum = (F_EQ,F_NE,F_LT,F_LE,F_GT,F_GE,F_SO,F_FX,F_FEX,F_VX,F_OX);
(* TResFlags = record
cr: byte;
flag: TResFlagsEnum;
end;
const const
{ arrays for boolean location conversions } { arrays for boolean location conversions }
{
flag_2_cond : array[TResFlags] of TAsmCond = flag_2_cond : array[TResFlags] of TAsmCond =
(C_E,C_NE,C_G,C_L,C_GE,C_LE,C_C,C_NC,C_A,C_AE,C_B,C_BE); (C_E,C_NE,C_LT,C_LE,C_GT,C_GE,???????????????);
*) }
{***************************************************************************** {*****************************************************************************
Reference Reference
@ -602,7 +607,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.3 2001-09-06 15:25:56 jonas Revision 1.4 2001-09-28 20:40:05 jonas
* several additions, almost complete (only some problems with resflags left)
Revision 1.3 2001/09/06 15:25:56 jonas
* changed type of tcg from object to class -> abstract methods are now * changed type of tcg from object to class -> abstract methods are now
a lot cleaner :) a lot cleaner :)
+ more updates: load_*_loc methods, op_*_* methods, g_flags2reg method + more updates: load_*_loc methods, op_*_* methods, g_flags2reg method