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

* made sqrt, sqr and abs internal for the sparc

Browse Source
This commit is contained in:
florian 2004-10-03 12:41:30 +00:00
parent 0f093b2001
commit 001292bf50
7 changed files with 141 additions and 147 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

89
compiler/sparc/cpugas.pas
View File

@ -116,38 +116,58 @@ implementation
if hp.typ<>ait_instruction then
exit;
op:=taicpu(hp).opcode;
{ FMOVd does not exist, rewrite it using 2 FMOVs }
if op=A_FMOVD then
begin
if (taicpu(hp).ops<>2) or
(taicpu(hp).oper[0]^.typ<>top_reg) or
(taicpu(hp).oper[1]^.typ<>top_reg) then
internalerror(200401045);
{ FMOVs %f<even>,%f<even> }
s:=#9+std_op2str[A_FMOVs]+#9+getopstr(taicpu(hp).oper[0]^)+','+getopstr(taicpu(hp).oper[1]^);
AsmWriteLn(s);
{ FMOVs %f<odd>,%f<odd> }
inc(taicpu(hp).oper[0]^.reg);
inc(taicpu(hp).oper[1]^.reg);
s:=#9+std_op2str[A_FMOVs]+#9+getopstr(taicpu(hp).oper[0]^)+','+getopstr(taicpu(hp).oper[1]^);
dec(taicpu(hp).oper[0]^.reg);
dec(taicpu(hp).oper[1]^.reg);
AsmWriteLn(s);
end
else
begin
{ call maybe not translated to call }
s:=#9+std_op2str[op]+cond2str[taicpu(hp).condition];
if taicpu(hp).delayslot_annulled then
s:=s+',a';
if taicpu(hp).ops>0 then
begin
s:=s+#9+getopstr(taicpu(hp).oper[0]^);
for i:=1 to taicpu(hp).ops-1 do
s:=s+','+getopstr(taicpu(hp).oper[i]^);
end;
AsmWriteLn(s);
end;
{ translate pseudoops, this should be move to a separate pass later, so it's done before
peephole optimization }
case op of
A_FABSd:
begin
if (taicpu(hp).ops<>2) or
(taicpu(hp).oper[0]^.typ<>top_reg) or
(taicpu(hp).oper[1]^.typ<>top_reg) then
internalerror(200401045);
{ FABSs %f<even>,%f<even> }
s:=#9+std_op2str[A_FABSs]+#9+getopstr(taicpu(hp).oper[0]^)+','+getopstr(taicpu(hp).oper[1]^);
AsmWriteLn(s);
{ FMOVs %f<odd>,%f<odd> }
inc(taicpu(hp).oper[0]^.reg);
inc(taicpu(hp).oper[1]^.reg);
s:=#9+std_op2str[A_FMOVs]+#9+getopstr(taicpu(hp).oper[0]^)+','+getopstr(taicpu(hp).oper[1]^);
dec(taicpu(hp).oper[0]^.reg);
dec(taicpu(hp).oper[1]^.reg);
AsmWriteLn(s);
end;
A_FMOVd:
begin
if (taicpu(hp).ops<>2) or
(taicpu(hp).oper[0]^.typ<>top_reg) or
(taicpu(hp).oper[1]^.typ<>top_reg) then
internalerror(200401045);
{ FMOVs %f<even>,%f<even> }
s:=#9+std_op2str[A_FMOVs]+#9+getopstr(taicpu(hp).oper[0]^)+','+getopstr(taicpu(hp).oper[1]^);
AsmWriteLn(s);
{ FMOVs %f<odd>,%f<odd> }
inc(taicpu(hp).oper[0]^.reg);
inc(taicpu(hp).oper[1]^.reg);
s:=#9+std_op2str[A_FMOVs]+#9+getopstr(taicpu(hp).oper[0]^)+','+getopstr(taicpu(hp).oper[1]^);
dec(taicpu(hp).oper[0]^.reg);
dec(taicpu(hp).oper[1]^.reg);
AsmWriteLn(s);
end
else
begin
{ call maybe not translated to call }
s:=#9+std_op2str[op]+cond2str[taicpu(hp).condition];
if taicpu(hp).delayslot_annulled then
s:=s+',a';
if taicpu(hp).ops>0 then
begin
s:=s+#9+getopstr(taicpu(hp).oper[0]^);
for i:=1 to taicpu(hp).ops-1 do
s:=s+','+getopstr(taicpu(hp).oper[i]^);
end;
AsmWriteLn(s);
end;
end;
end;
@ -169,7 +189,10 @@ begin
end.
{
$Log$
Revision 1.28 2004-06-20 08:55:32 florian
Revision 1.29 2004-10-03 12:42:22 florian
* made sqrt, sqr and abs internal for the sparc
Revision 1.28 2004/06/20 08:55:32 florian
* logs truncated
Revision 1.27 2004/06/20 07:11:32 florian

58
compiler/sparc/ncpuinln.pas
View File

@ -30,7 +30,7 @@ interface
node,ninl,ncginl;
type
tSparcInlineNode = class(tcgInlineNode)
tsparcinlinenode = class(tcgInlineNode)
function first_abs_real: tnode; override;
function first_sqr_real: tnode; override;
function first_sqrt_real: tnode; override;
@ -55,10 +55,10 @@ implementation
tgobj,ncgutil,cgobj,cg64f32,rgobj,rgcpu;
{*****************************************************************************
TSparcInlineNode
tsparcinlinenode
*****************************************************************************}
procedure tSparcInlineNode.load_fpu_location;
procedure tsparcinlinenode.load_fpu_location;
begin
secondpass(left);
location_force_fpureg(exprasmlist,left.location,true);
@ -71,7 +71,7 @@ implementation
end;
function tSparcInlineNode.first_abs_real : tnode;
function tsparcinlinenode.first_abs_real : tnode;
begin
expectloc:=LOC_FPUREGISTER;
registersint:=left.registersint;
@ -80,7 +80,7 @@ implementation
end;
function tSparcInlineNode.first_sqr_real : tnode;
function tsparcinlinenode.first_sqr_real : tnode;
begin
expectloc:=LOC_FPUREGISTER;
registersint:=left.registersint;
@ -89,7 +89,7 @@ implementation
end;
function tSparcInlineNode.first_sqrt_real : tnode;
function tsparcinlinenode.first_sqrt_real : tnode;
begin
expectloc:=LOC_FPUREGISTER;
registersint:=left.registersint;
@ -98,32 +98,62 @@ implementation
end;
procedure tSparcInlineNode.second_abs_real;
procedure tsparcinlinenode.second_abs_real;
begin
load_fpu_location;
exprasmlist.concat(taicpu.op_reg_reg(A_FABSs,left.location.register,location.register));
case tfloatdef(left.resulttype.def).typ of
s32real:
exprasmlist.concat(taicpu.op_reg_reg(A_FABSs,left.location.register,location.register));
s64real:
exprasmlist.concat(taicpu.op_reg_reg(A_FABSd,left.location.register,location.register));
s128real:
exprasmlist.concat(taicpu.op_reg_reg(A_FABSq,left.location.register,location.register));
else
internalerror(200410031);
end;
end;
procedure tSparcInlineNode.second_sqr_real;
procedure tsparcinlinenode.second_sqr_real;
begin
load_fpu_location;
exprasmlist.concat(taicpu.op_reg_reg_reg(A_FMULs,left.location.register,left.location.register,location.register));
case tfloatdef(left.resulttype.def).typ of
s32real:
exprasmlist.concat(taicpu.op_reg_reg_reg(A_FMULs,left.location.register,left.location.register,location.register));
s64real:
exprasmlist.concat(taicpu.op_reg_reg_reg(A_FMULd,left.location.register,left.location.register,location.register));
s128real:
exprasmlist.concat(taicpu.op_reg_reg_reg(A_FMULq,left.location.register,left.location.register,location.register));
else
internalerror(200410032);
end;
end;
procedure tSparcInlineNode.second_sqrt_real;
procedure tsparcinlinenode.second_sqrt_real;
begin
load_fpu_location;
exprasmlist.concat(taicpu.op_reg_reg(A_FSQRTs,left.location.register,location.register));
case tfloatdef(left.resulttype.def).typ of
s32real:
exprasmlist.concat(taicpu.op_reg_reg(A_FSQRTs,left.location.register,location.register));
s64real:
exprasmlist.concat(taicpu.op_reg_reg(A_FSQRTd,left.location.register,location.register));
s128real:
exprasmlist.concat(taicpu.op_reg_reg(A_FSQRTq,left.location.register,location.register));
else
internalerror(200410033);
end;
end;
begin
cInlineNode:=tSparcInlineNode;
cInlineNode:=tsparcinlinenode;
end.
{
$Log$
Revision 1.9 2004-06-20 08:55:32 florian
Revision 1.10 2004-10-03 12:42:22 florian
* made sqrt, sqr and abs internal for the sparc
Revision 1.9 2004/06/20 08:55:32 florian
* logs truncated
Revision 1.8 2004/02/03 22:32:54 peter

9
compiler/sparc/opcode.inc
View File

@ -68,11 +68,16 @@ A_set,
A_skipz,A_skipnz,
A_tst,
{ Internal instructions }
A_FMOVD
A_FMOVd,
A_FABSd,
A_FABSq
{
$Log$
Revision 1.14 2004-06-20 08:55:32 florian
Revision 1.15 2004-10-03 12:42:22 florian
* made sqrt, sqr and abs internal for the sparc
Revision 1.14 2004/06/20 08:55:32 florian
* logs truncated
Revision 1.13 2004/06/16 20:07:11 florian

8
compiler/sparc/strinst.inc
View File

@ -66,10 +66,14 @@
'skipz','skipnz',
'tst',
{ internal instructions }
'fmovd'
'fmovd',
'fabsd','fabsq'
{
$Log$
Revision 1.13 2004-06-20 08:55:32 florian
Revision 1.14 2004-10-03 12:42:22 florian
* made sqrt, sqr and abs internal for the sparc
Revision 1.13 2004/06/20 08:55:32 florian
* logs truncated
Revision 1.12 2004/06/16 20:07:11 florian

6
compiler/x86/cgx86.pas
View File

@ -335,7 +335,6 @@ unit cgx86;
OS_F64 :
begin
op:=A_FLD;
{ ???? }
s:=S_FL;
end;
OS_F80 :
@ -1673,7 +1672,10 @@ unit cgx86;
end.
{
$Log$
Revision 1.125 2004-09-25 14:23:55 peter
Revision 1.126 2004-10-03 12:42:22 florian
* made sqrt, sqr and abs internal for the sparc
Revision 1.125 2004/09/25 14:23:55 peter
* ungetregister is now only used for cpuregisters, renamed to
ungetcpuregister
* renamed (get|unget)explicitregister(s) to ..cpuregister

95
rtl/sparc/math.inc
View File

@ -15,25 +15,6 @@
**********************************************************************}
{$ifdef unused}
{****************************************************************************
Int to real helpers
****************************************************************************}
const
longint_to_real_helper: int64 = $4330000080000000;
cardinal_to_real_helper: int64 = $430000000000000;
int_to_real_factor: double = double(high(cardinal))+1.0;
{****************************************************************************
EXTENDED data type routines
****************************************************************************}
{$define FPC_SYSTEM_HAS_PI}
function pi : double;[internproc:in_pi];
{$define FPC_SYSTEM_HAS_ABS}
function abs(d : extended) : extended;[internproc:in_abs_extended];
@ -43,80 +24,12 @@ const
{$define FPC_SYSTEM_HAS_SQRT}
function sqrt(d : extended) : extended;[internproc:in_sqrt_extended];
{
function arctan(d : extended) : extended;[internconst:in_arctan_extended];
begin
runerror(207);
end;
function ln(d : extended) : extended;[internconst:in_ln_extended];
begin
runerror(207);
end;
function sin(d : extended) : extended;[internconst: in_sin_extended];
begin
runerror(207);
end;
function cos(d : extended) : extended;[internconst:in_cos_extended];
begin
runerror(207);
end;
function exp(d : extended) : extended;[internconst:in_const_exp];
begin
runerror(207);
end;
function frac(d : extended) : extended;[internconst:in_const_frac];
begin
runerror(207);
end;
}
{ define FPC_SYSTEM_HAS_INT}
{$warning FIX ME}
function int(d : extended) : extended;[internconst:in_const_int];
begin
runerror(207);
end;
{ define FPC_SYSTEM_HAS_TRUNC}
{$warning FIX ME}
function trunc(d : extended) : int64;{assembler;}[internconst:in_const_trunc];
{ input: d in fr1 }
{ output: result in r3 }
{assembler;}
var
temp: packed record
case byte of
0: (l1,l2: longint);
1: (d: double);
end;
begin{asm}
{ fctiwz f1,f1
stfd f1,temp
lwz r3,temp
lwz r4,4+temp}
end{ ['R3','F1']};
{ define FPC_SYSTEM_HAS_ROUND}
function round(d : extended) : int64;[internconst:in_const_round, external name 'FPC_ROUND'];
function fpc_round(d : extended) : int64;[public, alias:'FPC_ROUND'];compilerproc;
begin
end;
{$endif}
{
$Log$
Revision 1.9 2004-05-31 14:31:57 peter
Revision 1.10 2004-10-03 12:41:30 florian
* made sqrt, sqr and abs internal for the sparc
Revision 1.9 2004/05/31 14:31:57 peter
* remove comment warnings
Revision 1.8 2004/01/06 21:33:38 peter

23
rtl/sparc/sparc.inc
View File

@ -81,7 +81,7 @@ function Sptr:Pointer;assembler;nostackframe;
mov %sp,%o0
end;
{ $ifdef dummy}
{$define FPC_SYSTEM_HAS_MOVE}
procedure Move(const source;var dest;count:longint);[public, alias: 'FPC_MOVE'];assembler;
{
@ -279,11 +279,28 @@ procedure Move(const source;var dest;count:longint);[public, alias: 'FPC_MOVE'];
nop
.Lmoveexit:
end;
{ $endif dummy}
{****************************************************************************
Integer math
****************************************************************************}
{$define FPC_SYSTEM_HAS_ABS_LONGINT}
function abs(l:longint):longint; assembler;{$ifdef SYSTEMINLINE}inline;{$endif}nostackframe;[internconst:in_const_abs];
asm
sra %o0,31,%g1
add %o0,%g1,%o0
xor %o0,%g1,%o0
end;
{
$Log$
Revision 1.11 2004-10-02 20:46:20 florian
Revision 1.12 2004-10-03 12:41:30 florian
* made sqrt, sqr and abs internal for the sparc
Revision 1.11 2004/10/02 20:46:20 florian
* made assembler implementation of move
Revision 1.10 2004/09/23 11:30:41 florian