paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-04 15:59:28 +01:00
Code Issues Packages Projects Releases Wiki Activity
b0d050a490
fpc/compiler/arm/narmadd.pas
Jonas Maebe d1538ab023 o added ARM VPFv2/VFPv3 support: 
+ RTL support:
      o VFP exceptions are disabled by default on Darwin,
        because they cause kernel panics on iPhoneOS 2.2.1 at least
      o all denormals are truncated to 0 on Darwin, because disabling
        that also causes kernel panics on iPhoneOS 2.2.1 (probably
        because otherwise denormals can also cause exceptions)
    * set softfloat rounding mode correctly for non-wince/darwin/vfp
      targets
    + compiler support: only half the number of single precision
      registers is available due to limitations of the register
      allocator
    + added a number of comments about why the stackframe on ARM is
      set up the way it is by the compiler
    + added regtype and subregtype info to regsets, because they're
      also used for VFP registers (+ support in assembler reader)
    + various generic support routines for dealing with floating point
      values located in integer registers that have to be transferred to
      mm registers (needed for VFP)
    * renamed use_sse() to use_vectorfpu() and also use it for
      ARM/vfp support
    o only superficially tested for Linux (compiler compiled with -Cpvfpv6
      -Cfvfpv2 works on a Cortex-A8, no testsuite run performed -- at least
      the fpu exception handler still needs to be implemented), Darwin has
      been tested more thoroughly
  + added ARMv6 cpu type and made it default for Darwin/ARM
  + ARMv6+ implementations of atomic operations using ldrex/strex
  * don't use r9 on Darwin/ARM, as it's reserved under certain
    circumstances (don't know yet which ones)
  * changed C-test object files for ARM/Darwin to ARMv6 versions
  * check in assembler reader that regsets are not empty, because
    instructions with a regset operand have undefined behaviour in that
    case
  * fixed resultdef of tarmtypeconvnode.first_int_to_real in case of
    int64->single type conversion
  * fixed constant pool locations in case 64 bit constants are generated,
    and/or when vfp instructions with limited reach are present

  WARNING: when using VFP on an ARMv6 or later cpu, you *must* compile all
    code with -Cparmv6 (or higher), or you will get crashes. The reason is
    that storing/restoring multiple VFP registers must happen using
    different instructions on pre/post-ARMv6.

git-svn-id: trunk@14317 -
2009-12-03 22:46:30 +00:00

435 lines
15 KiB
ObjectPascal
Raw Blame History

{
Copyright (c) 2000-2002 by Florian Klaempfl
Code generation for add nodes on the ARM
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 narmadd;
{$i fpcdefs.inc}
interface
uses
node,ncgadd,cpubase;
type
tarmaddnode = class(tcgaddnode)
private
function GetResFlags(unsigned:Boolean):TResFlags;
public
function pass_1 : tnode;override;
protected
procedure second_addfloat;override;
procedure second_cmpfloat;override;
procedure second_cmpordinal;override;
procedure second_cmpsmallset;override;
procedure second_cmp64bit;override;
end;
implementation
uses
globtype,systems,
cutils,verbose,globals,
symconst,symdef,paramgr,
aasmbase,aasmtai,aasmdata,aasmcpu,defutil,htypechk,
cgbase,cgutils,cgcpu,
cpuinfo,pass_1,pass_2,regvars,procinfo,
cpupara,
ncon,nset,nadd,
ncgutil,tgobj,rgobj,rgcpu,cgobj,cg64f32;
{*****************************************************************************
TSparcAddNode
*****************************************************************************}
function tarmaddnode.GetResFlags(unsigned:Boolean):TResFlags;
begin
case NodeType of
equaln:
GetResFlags:=F_EQ;
unequaln:
GetResFlags:=F_NE;
else
if not(unsigned) then
begin
if nf_swapped in flags then
case NodeType of
ltn:
GetResFlags:=F_GT;
lten:
GetResFlags:=F_GE;
gtn:
GetResFlags:=F_LT;
gten:
GetResFlags:=F_LE;
end
else
case NodeType of
ltn:
GetResFlags:=F_LT;
lten:
GetResFlags:=F_LE;
gtn:
GetResFlags:=F_GT;
gten:
GetResFlags:=F_GE;
end;
end
else
begin
if nf_swapped in Flags then
case NodeType of
ltn:
GetResFlags:=F_HI;
lten:
GetResFlags:=F_CS;
gtn:
GetResFlags:=F_CC;
gten:
GetResFlags:=F_LS;
end
else
case NodeType of
ltn:
GetResFlags:=F_CC;
lten:
GetResFlags:=F_LS;
gtn:
GetResFlags:=F_HI;
gten:
GetResFlags:=F_CS;
end;
end;
end;
end;
procedure tarmaddnode.second_addfloat;
var
op : TAsmOp;
singleprec: boolean;
begin
pass_left_right;
if (nf_swapped in flags) then
swapleftright;
case current_settings.fputype of
fpu_fpa,
fpu_fpa10,
fpu_fpa11:
begin
{ force fpureg as location, left right doesn't matter
as both will be in a fpureg }
location_force_fpureg(current_asmdata.CurrAsmList,left.location,true);
location_force_fpureg(current_asmdata.CurrAsmList,right.location,(left.location.loc<>LOC_CFPUREGISTER));
location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef));
if left.location.loc<>LOC_CFPUREGISTER then
location.register:=left.location.register
else
location.register:=right.location.register;
case nodetype of
addn :
op:=A_ADF;
muln :
op:=A_MUF;
subn :
op:=A_SUF;
slashn :
op:=A_DVF;
else
internalerror(200308313);
end;
current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg_reg(op,
location.register,left.location.register,right.location.register),
cgsize2fpuoppostfix[def_cgsize(resultdef)]));
end;
fpu_vfpv2,
fpu_vfpv3:
begin
{ force mmreg as location, left right doesn't matter
as both will be in a fpureg }
location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,true);
location_force_mmregscalar(current_asmdata.CurrAsmList,right.location,true);
location_reset(location,LOC_MMREGISTER,def_cgsize(resultdef));
if left.location.loc<>LOC_CMMREGISTER then
location.register:=left.location.register
else if right.location.loc<>LOC_CMMREGISTER then
location.register:=right.location.register
else
location.register:=cg.getmmregister(current_asmdata.CurrAsmList,location.size);
singleprec:=tfloatdef(left.resultdef).floattype=s32real;
case nodetype of
addn :
if singleprec then
op:=A_FADDS
else
op:=A_FADDD;
muln :
if singleprec then
op:=A_FMULS
else
op:=A_FMULD;
subn :
if singleprec then
op:=A_FSUBS
else
op:=A_FSUBD;
slashn :
if singleprec then
op:=A_FDIVS
else
op:=A_FDIVD;
else
internalerror(2009111401);
end;
current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(op,
location.register,left.location.register,right.location.register));
end;
fpu_soft:
{ this case should be handled already by pass1 }
internalerror(200308252);
else
internalerror(200308251);
end;
end;
procedure tarmaddnode.second_cmpfloat;
var
op: TAsmOp;
begin
pass_left_right;
if (nf_swapped in flags) then
swapleftright;
location_reset(location,LOC_FLAGS,OS_NO);
location.resflags:=getresflags(true);
case current_settings.fputype of
fpu_fpa,
fpu_fpa10,
fpu_fpa11:
begin
{ force fpureg as location, left right doesn't matter
as both will be in a fpureg }
location_force_fpureg(current_asmdata.CurrAsmList,left.location,true);
location_force_fpureg(current_asmdata.CurrAsmList,right.location,true);
if nodetype in [equaln,unequaln] then
current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_CMF,
left.location.register,right.location.register),
cgsize2fpuoppostfix[def_cgsize(resultdef)]))
else
current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_CMFE,
left.location.register,right.location.register),
cgsize2fpuoppostfix[def_cgsize(resultdef)]));
end;
fpu_vfpv2,
fpu_vfpv3:
begin
location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,true);
location_force_mmregscalar(current_asmdata.CurrAsmList,right.location,true);
if (tfloatdef(left.resultdef).floattype=s32real) then
if nodetype in [equaln,unequaln] then
op:=A_FCMPS
else
op:=A_FCMPES
else if nodetype in [equaln,unequaln] then
op:=A_FCMPD
else
op:=A_FCMPED;
current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op,
left.location.register,right.location.register));
current_asmdata.CurrAsmList.concat(taicpu.op_none(A_FMSTAT));
end;
fpu_soft:
{ this case should be handled already by pass1 }
internalerror(2009112404);
end;
location_reset(location,LOC_FLAGS,OS_NO);
location.resflags:=getresflags(false);
end;
procedure tarmaddnode.second_cmpsmallset;
var
tmpreg : tregister;
begin
pass_left_right;
location_reset(location,LOC_FLAGS,OS_NO);
force_reg_left_right(false,false);
case nodetype of
equaln:
begin
current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMP,left.location.register,right.location.register));
location.resflags:=F_EQ;
end;
unequaln:
begin
current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMP,left.location.register,right.location.register));
location.resflags:=F_NE;
end;
lten,
gten:
begin
if (not(nf_swapped in flags) and
(nodetype = lten)) or
((nf_swapped in flags) and
(nodetype = gten)) then
swapleftright;
tmpreg:=cg.getintregister(current_asmdata.CurrAsmList,location.size);
current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_AND,tmpreg,left.location.register,right.location.register));
current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMP,tmpreg,right.location.register));
location.resflags:=F_EQ;
end;
else
internalerror(2004012401);
end;
end;
procedure tarmaddnode.second_cmp64bit;
var
unsigned : boolean;
oldnodetype : tnodetype;
begin
pass_left_right;
force_reg_left_right(false,false);
unsigned:=not(is_signed(left.resultdef)) or
not(is_signed(right.resultdef));
{ operation requiring proper N, Z and C flags ? }
if unsigned or (nodetype in [equaln,unequaln]) then
begin
location_reset(location,LOC_FLAGS,OS_NO);
location.resflags:=getresflags(unsigned);
current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMP,left.location.register64.reghi,right.location.register64.reghi));
if current_settings.cputype in cpu_thumb2 then
current_asmdata.CurrAsmList.concat(taicpu.op_cond(A_IT, C_EQ));
current_asmdata.CurrAsmList.concat(setcondition(taicpu.op_reg_reg(A_CMP,left.location.register64.reglo,right.location.register64.reglo),C_EQ));
end
else
{ operation requiring proper N, Z and V flags ? }
begin
location_reset(location,LOC_JUMP,OS_NO);
current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMP,left.location.register64.reghi,right.location.register64.reghi));
{ the jump the sequence is a little bit hairy }
case nodetype of
ltn,gtn:
begin
cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(false),current_procinfo.CurrTrueLabel);
{ cheat a little bit for the negative test }
toggleflag(nf_swapped);
cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(false),current_procinfo.CurrFalseLabel);
toggleflag(nf_swapped);
end;
lten,gten:
begin
oldnodetype:=nodetype;
if nodetype=lten then
nodetype:=ltn
else
nodetype:=gtn;
cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(unsigned),current_procinfo.CurrTrueLabel);
{ cheat for the negative test }
if nodetype=ltn then
nodetype:=gtn
else
nodetype:=ltn;
cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(unsigned),current_procinfo.CurrFalseLabel);
nodetype:=oldnodetype;
end;
end;
current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMP,left.location.register64.reglo,right.location.register64.reglo));
{ the comparisaion of the low dword have to be
always unsigned! }
cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(true),current_procinfo.CurrTrueLabel);
cg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel);
end;
end;
function tarmaddnode.pass_1 : tnode;
var
unsigned : boolean;
begin
result:=inherited pass_1;
if not(assigned(result)) then
begin
unsigned:=not(is_signed(left.resultdef)) or
not(is_signed(right.resultdef));
if is_64bit(left.resultdef) and
((nodetype in [equaln,unequaln]) or
(unsigned and (nodetype in [ltn,lten,gtn,gten]))
) then
expectloc:=LOC_FLAGS;
end;
end;
procedure tarmaddnode.second_cmpordinal;
var
unsigned : boolean;
tmpreg : tregister;
b : byte;
begin
pass_left_right;
force_reg_left_right(true,true);
unsigned:=not(is_signed(left.resultdef)) or
not(is_signed(right.resultdef));
if right.location.loc = LOC_CONSTANT then
begin
if is_shifter_const(right.location.value,b) then
current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_CMP,left.location.register,right.location.value))
else
begin
tmpreg:=cg.getintregister(current_asmdata.CurrAsmList,location.size);
cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,
right.location.value,tmpreg);
current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMP,left.location.register,tmpreg));
end;
end
else
current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMP,left.location.register,right.location.register));
location_reset(location,LOC_FLAGS,OS_NO);
location.resflags:=getresflags(unsigned);
end;
begin
caddnode:=tarmaddnode;
end.
Reference in New Issue View Git Blame Copy Permalink