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

* fixed more sparc overflow stuff

Browse Source 
* fixed some op64 stuff for sparc
This commit is contained in:
florian 2004-09-29 18:55:40 +00:00
parent b65cffcdef
commit 15d3388449
3 changed files with 137 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
compiler/cgobj.pas
View File

@ -259,8 +259,8 @@ unit cgobj;
{ are any processors that support it (JM) }
procedure a_op_const_reg_reg(list: taasmoutput; op: TOpCg; size: tcgsize; a: aint; src, dst: tregister); virtual;
procedure a_op_reg_reg_reg(list: taasmoutput; op: TOpCg; size: tcgsize; src1, src2, dst: tregister); virtual;
procedure a_op_const_reg_reg_setflags(list: taasmoutput; op: TOpCg; size: tcgsize; a: aint; src, dst: tregister;setflags : boolean); virtual;
procedure a_op_reg_reg_reg_setflags(list: taasmoutput; op: TOpCg; size: tcgsize; src1, src2, dst: tregister;setflags : boolean); virtual;
procedure a_op_const_reg_reg_checkoverflow(list: taasmoutput; op: TOpCg; size: tcgsize; a: aint; src, dst: tregister;setflags : boolean;var ovloc : tlocation); virtual;
procedure a_op_reg_reg_reg_checkoverflow(list: taasmoutput; op: TOpCg; size: tcgsize; src1, src2, dst: tregister;setflags : boolean;var ovloc : tlocation); virtual;
{ comparison operations }
procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aint;reg : tregister;
@ -386,7 +386,8 @@ unit cgobj;
procedure g_rangecheck(list: taasmoutput; const l:tlocation; fromdef,todef: tdef); virtual;
{# Generates overflow checking code for a node }
procedure g_overflowcheck(list: taasmoutput; const l:tlocation; def:tdef); virtual; abstract;
procedure g_overflowcheck(list: taasmoutput; const Loc:tlocation; def:tdef); virtual;abstract;
procedure g_overflowCheck_loc(List:TAasmOutput;const Loc:TLocation;def:TDef;ovloc : tlocation);virtual;
procedure g_copyvaluepara_openarray(list : taasmoutput;const ref, lenref:treference;elesize:aint);virtual;
procedure g_releasevaluepara_openarray(list : taasmoutput;const ref:treference);virtual;
@ -1269,15 +1270,17 @@ implementation
end;
procedure tcg.a_op_const_reg_reg_setflags(list: taasmoutput; op: TOpCg; size: tcgsize; a: aint; src, dst: tregister;setflags : boolean);
procedure tcg.a_op_const_reg_reg_checkoverflow(list: taasmoutput; op: TOpCg; size: tcgsize; a: aint; src, dst: tregister;setflags : boolean;var ovloc : tlocation);
begin
a_op_const_reg_reg(list,op,size,a,src,dst);
ovloc.loc:=LOC_VOID;
end;
procedure tcg.a_op_reg_reg_reg_setflags(list: taasmoutput; op: TOpCg; size: tcgsize; src1, src2, dst: tregister;setflags : boolean);
procedure tcg.a_op_reg_reg_reg_checkoverflow(list: taasmoutput; op: TOpCg; size: tcgsize; src1, src2, dst: tregister;setflags : boolean;var ovloc : tlocation);
begin
a_op_reg_reg_reg(list,op,size,src1,src2,dst);
ovloc.loc:=LOC_VOID;
end;
@ -1947,6 +1950,12 @@ implementation
end;
procedure tcg.g_overflowCheck_loc(List:TAasmOutput;const Loc:TLocation;def:TDef;ovloc : tlocation);
begin
g_overflowCheck(list,loc,def);
end;
procedure tcg.g_flags2ref(list: taasmoutput; size: TCgSize; const f: tresflags; const ref:TReference);
var
@ -2217,7 +2226,11 @@ finalization
end.
{
$Log$
Revision 1.172 2004-09-26 21:04:35 florian
Revision 1.173 2004-09-29 18:55:40 florian
* fixed more sparc overflow stuff
* fixed some op64 stuff for sparc
Revision 1.172 2004/09/26 21:04:35 florian
+ partial overflow checking on sparc; multiplication still missing
Revision 1.171 2004/09/26 17:45:30 peter

33
compiler/ncgadd.pas
View File

@ -460,12 +460,12 @@ interface
addn :
begin
op:=OP_ADD;
checkoverflow := true;
checkoverflow:=true;
end;
subn :
begin
op:=OP_SUB;
checkoverflow := true;
checkoverflow:=true;
end;
xorn:
op:=OP_XOR;
@ -617,6 +617,7 @@ interface
checkoverflow : boolean;
cgop : topcg;
tmpreg : tregister;
ovloc : tlocation;
begin
pass_left_right;
force_reg_left_right(false,(cs_check_overflow in aktlocalswitches) and
@ -666,13 +667,13 @@ interface
if nodetype<>subn then
begin
if (right.location.loc >LOC_CONSTANT) then
cg.a_op_reg_reg_reg_setflags(exprasmlist,cgop,location.size,
cg.a_op_reg_reg_reg_checkoverflow(exprasmlist,cgop,location.size,
left.location.register,right.location.register,
location.register,checkoverflow)
location.register,checkoverflow,ovloc)
else
cg.a_op_const_reg_reg_setflags(exprasmlist,cgop,location.size,
cg.a_op_const_reg_reg_checkoverflow(exprasmlist,cgop,location.size,
right.location.value,left.location.register,
location.register,checkoverflow);
location.register,checkoverflow,ovloc);
end
else { subtract is a special case since its not commutative }
begin
@ -681,27 +682,27 @@ interface
if left.location.loc<>LOC_CONSTANT then
begin
if right.location.loc<>LOC_CONSTANT then
cg.a_op_reg_reg_reg_setflags(exprasmlist,OP_SUB,location.size,
cg.a_op_reg_reg_reg_checkoverflow(exprasmlist,OP_SUB,location.size,
right.location.register,left.location.register,
location.register,checkoverflow)
location.register,checkoverflow,ovloc)
else
cg.a_op_const_reg_reg_setflags(exprasmlist,OP_SUB,location.size,
cg.a_op_const_reg_reg_checkoverflow(exprasmlist,OP_SUB,location.size,
aword(right.location.value),left.location.register,
location.register,checkoverflow);
location.register,checkoverflow,ovloc);
end
else
begin
tmpreg:=cg.getintregister(exprasmlist,location.size);
cg.a_load_const_reg(exprasmlist,location.size,
aword(left.location.value),tmpreg);
cg.a_op_reg_reg_reg_setflags(exprasmlist,OP_SUB,location.size,
right.location.register,tmpreg,location.register,checkoverflow);
cg.a_op_reg_reg_reg_checkoverflow(exprasmlist,OP_SUB,location.size,
right.location.register,tmpreg,location.register,checkoverflow,ovloc);
end;
end;
{ emit overflow check if required }
if checkoverflow then
cg.g_overflowcheck(exprasmlist,Location,ResultType.Def);
cg.g_overflowcheck_loc(exprasmlist,Location,ResultType.Def,ovloc);
end;
@ -777,7 +778,11 @@ begin
end.
{
$Log$
Revision 1.33 2004-09-26 21:04:35 florian
Revision 1.34 2004-09-29 18:55:40 florian
* fixed more sparc overflow stuff
* fixed some op64 stuff for sparc
Revision 1.33 2004/09/26 21:04:35 florian
+ partial overflow checking on sparc; multiplication still missing
Revision 1.32 2004/09/25 14:23:54 peter

121
compiler/sparc/cgcpu.pas
View File

@ -61,8 +61,8 @@ interface
procedure a_op_reg_reg(list:TAasmOutput;Op:TOpCG;size:TCGSize;src, dst:TRegister);override;
procedure a_op_const_reg_reg(list:TAasmOutput;op:TOpCg;size:tcgsize;a:aint;src, dst:tregister);override;
procedure a_op_reg_reg_reg(list:TAasmOutput;op:TOpCg;size:tcgsize;src1, src2, dst:tregister);override;
procedure a_op_const_reg_reg_setflags(list: taasmoutput; op: TOpCg; size: tcgsize; a: aint; src, dst: tregister;setflags : boolean);override;
procedure a_op_reg_reg_reg_setflags(list: taasmoutput; op: TOpCg; size: tcgsize; src1, src2, dst: tregister;setflags : boolean);override;
procedure a_op_const_reg_reg_checkoverflow(list: taasmoutput; op: TOpCg; size: tcgsize; a: aint; src, dst: tregister;setflags : boolean;var ovloc : tlocation);override;
procedure a_op_reg_reg_reg_checkoverflow(list: taasmoutput; op: TOpCg; size: tcgsize; src1, src2, dst: tregister;setflags : boolean;var ovloc : tlocation);override;
{ move instructions }
procedure a_load_const_reg(list:TAasmOutput;size:tcgsize;a:aint;reg:tregister);override;
procedure a_load_const_ref(list:TAasmOutput;size:tcgsize;a:aint;const ref:TReference);override;
@ -83,6 +83,7 @@ interface
procedure a_jmp_flags(list:TAasmOutput;const f:TResFlags;l:tasmlabel);override;
procedure g_flags2reg(list:TAasmOutput;Size:TCgSize;const f:tresflags;reg:TRegister);override;
procedure g_overflowCheck(List:TAasmOutput;const Loc:TLocation;def:TDef);override;
procedure g_overflowCheck_loc(List:TAasmOutput;const Loc:TLocation;def:TDef;ovloc : tlocation);override;
procedure g_proc_entry(list : taasmoutput;localsize : longint;nostackframe:boolean);override;
procedure g_proc_exit(list : taasmoutput;parasize:longint;nostackframe:boolean);override;
procedure g_restore_all_registers(list:TAasmOutput;const funcretparaloc:TCGPara);override;
@ -782,10 +783,12 @@ implementation
end;
procedure tcgsparc.a_op_const_reg_reg_setflags(list: taasmoutput; op: TOpCg; size: tcgsize; a: aint; src, dst: tregister;setflags : boolean);
procedure tcgsparc.a_op_const_reg_reg_checkoverflow(list: taasmoutput; op: TOpCg; size: tcgsize; a: aint; src, dst: tregister;setflags : boolean;var ovloc : tlocation);
var
power : longInt;
tmpreg1,tmpreg2 : tregister;
begin
ovloc.loc:=LOC_VOID;
case op of
OP_SUB,
OP_ADD :
@ -798,16 +801,63 @@ implementation
end;
end;
if setflags then
handle_reg_const_reg(list,TOpCG2AsmOpWithFlags[op],src,a,dst)
begin
handle_reg_const_reg(list,TOpCG2AsmOpWithFlags[op],src,a,dst);
case op of
OP_MUL:
begin
tmpreg1:=GetIntRegister(list,OS_INT);
list.concat(taicpu.op_reg_reg(A_MOV,NR_Y,tmpreg1));
list.concat(taicpu.op_reg_reg(A_CMP,NR_G0,tmpreg1));
ovloc.loc:=LOC_FLAGS;
ovloc.resflags:=F_NE;
end;
OP_IMUL:
begin
tmpreg1:=GetIntRegister(list,OS_INT);
tmpreg2:=GetIntRegister(list,OS_INT);
list.concat(taicpu.op_reg_reg(A_MOV,NR_Y,tmpreg1));
list.concat(taicpu.op_reg_const_reg(A_SRL,dst,31,tmpreg2));
list.concat(taicpu.op_reg_reg(A_CMP,tmpreg1,tmpreg2));
ovloc.loc:=LOC_FLAGS;
ovloc.resflags:=F_NE;
end;
end;
end
else
handle_reg_const_reg(list,TOpCG2AsmOp[op],src,a,dst)
end;
procedure tcgsparc.a_op_reg_reg_reg_setflags(list: taasmoutput; op: TOpCg; size: tcgsize; src1, src2, dst: tregister;setflags : boolean);
procedure tcgsparc.a_op_reg_reg_reg_checkoverflow(list: taasmoutput; op: TOpCg; size: tcgsize; src1, src2, dst: tregister;setflags : boolean;var ovloc : tlocation);
var
tmpreg1,tmpreg2 : tregister;
begin
ovloc.loc:=LOC_VOID;
if setflags then
list.concat(taicpu.op_reg_reg_reg(TOpCG2AsmOpWithFlags[op],src2,src1,dst))
begin
list.concat(taicpu.op_reg_reg_reg(TOpCG2AsmOpWithFlags[op],src2,src1,dst));
case op of
OP_MUL:
begin
tmpreg1:=GetIntRegister(list,OS_INT);
list.concat(taicpu.op_reg_reg(A_MOV,NR_Y,tmpreg1));
list.concat(taicpu.op_reg_reg(A_CMP,NR_G0,tmpreg1));
ovloc.loc:=LOC_FLAGS;
ovloc.resflags:=F_NE;
end;
OP_IMUL:
begin
tmpreg1:=GetIntRegister(list,OS_INT);
tmpreg2:=GetIntRegister(list,OS_INT);
list.concat(taicpu.op_reg_reg(A_MOV,NR_Y,tmpreg1));
list.concat(taicpu.op_reg_const_reg(A_SRL,dst,31,tmpreg2));
list.concat(taicpu.op_reg_reg(A_CMP,tmpreg1,tmpreg2));
ovloc.loc:=LOC_FLAGS;
ovloc.resflags:=F_NE;
end;
end;
end
else
list.concat(taicpu.op_reg_reg_reg(TOpCG2AsmOp[op],src2,src1,dst))
end;
@ -890,26 +940,49 @@ implementation
end;
procedure TCgSparc.g_overflowCheck(List:TAasmOutput;const Loc:TLocation;def:TDef);
procedure tcgsparc.g_overflowCheck(List:TAasmOutput;const Loc:TLocation;def:TDef);
var
l : tlocation;
begin
l.loc:=LOC_VOID;
g_overflowCheck_loc(list,loc,def,l);
end;
procedure TCgSparc.g_overflowCheck_loc(List:TAasmOutput;const Loc:TLocation;def:TDef;ovloc : tlocation);
var
hl : tasmlabel;
ai:TAiCpu;
hflags : tresflags;
begin
if not(cs_check_overflow in aktlocalswitches) then
exit;
objectlibrary.getlabel(hl);
if not((def.deftype=pointerdef) or
((def.deftype=orddef) and
(torddef(def).typ in [u64bit,u16bit,u32bit,u8bit,uchar,bool8bit,bool16bit,bool32bit]))) then
begin
ai:=TAiCpu.Op_sym(A_Bxx,hl);
ai.SetCondition(C_NO);
list.Concat(ai);
{ Delay slot }
list.Concat(TAiCpu.Op_none(A_NOP));
end
else
a_jmp_cond(list,OC_AE,hl);
case ovloc.loc of
LOC_VOID:
begin
if not((def.deftype=pointerdef) or
((def.deftype=orddef) and
(torddef(def).typ in [u64bit,u16bit,u32bit,u8bit,uchar,bool8bit,bool16bit,bool32bit]))) then
begin
ai:=TAiCpu.Op_sym(A_Bxx,hl);
ai.SetCondition(C_NO);
list.Concat(ai);
{ Delay slot }
list.Concat(TAiCpu.Op_none(A_NOP));
end
else
a_jmp_cond(list,OC_AE,hl);
end;
LOC_FLAGS:
begin
hflags:=ovloc.resflags;
inverse_flags(hflags);
cg.a_jmp_flags(list,hflags,hl);
end;
else
internalerror(200409281);
end;
a_call_name(list,'FPC_OVERFLOW');
a_label(list,hl);
@ -1196,7 +1269,7 @@ implementation
end;
get_64bit_ops(op,op1,op2);
tcgsparc(cg).handle_reg_const_reg(list,op1,regdst.reglo,aint(lo(value)),regdst.reglo);
tcgsparc(cg).handle_reg_const_reg(list,op1,regdst.reghi,aint(hi(value)),regdst.reghi);
tcgsparc(cg).handle_reg_const_reg(list,op2,regdst.reghi,aint(hi(value)),regdst.reghi);
end;
@ -1211,7 +1284,7 @@ implementation
end;
get_64bit_ops(op,op1,op2);
tcgsparc(cg).handle_reg_const_reg(list,op1,regsrc.reglo,aint(lo(value)),regdst.reglo);
tcgsparc(cg).handle_reg_const_reg(list,op1,regsrc.reghi,aint(hi(value)),regdst.reghi);
tcgsparc(cg).handle_reg_const_reg(list,op2,regsrc.reghi,aint(hi(value)),regdst.reghi);
end;
@ -1236,7 +1309,11 @@ begin
end.
{
$Log$
Revision 1.92 2004-09-27 21:24:17 peter
Revision 1.93 2004-09-29 18:55:40 florian
* fixed more sparc overflow stuff
* fixed some op64 stuff for sparc
Revision 1.92 2004/09/27 21:24:17 peter
* fixed passing of flaot parameters. The general size is still float,
only the size of the locations is now OS_32