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

* forgot to add file: should have been added with r1176

Browse Source 
git-svn-id: trunk@1179 -
This commit is contained in:
florian 2005-09-24 17:44:45 +00:00
parent a8109acb5c
commit faa5630fab
2 changed files with 142 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -56,6 +56,7 @@ compiler/arm/itcpugas.pas svneol=native#text/plain
compiler/arm/narmadd.pas svneol=native#text/plain
compiler/arm/narmcal.pas svneol=native#text/plain
compiler/arm/narmcnv.pas svneol=native#text/plain
compiler/arm/narmcon.pas svneol=native#text/plain
compiler/arm/narminl.pas svneol=native#text/plain
compiler/arm/narmmat.pas svneol=native#text/plain
compiler/arm/raarm.pas svneol=native#text/plain

141
compiler/arm/narmcon.pas Normal file
View File

@ -0,0 +1,141 @@
{
Copyright (c) 2005 by Florian Klaempfl
Code generation for const 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 narmcon;
{$i fpcdefs.inc}
interface
uses
node,ncgcon,cpubase;
type
tarmrealconstnode = class(tcgrealconstnode)
procedure pass_2;override;
end;
implementation
uses
verbose,
globtype,globals,
cpuinfo,
aasmbase,aasmtai,
symconst,symdef,
defutil,
cgbase,cgutils,
procinfo,
ncon;
{*****************************************************************************
TARMREALCONSTNODE
*****************************************************************************}
procedure tarmrealconstnode.pass_2;
{ I suppose the parser/pass_1 must make sure the generated real }
{ constants are actually supported by the target processor? (JM) }
const
floattype2ait:array[tfloattype] of taitype=
(ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_comp_64bit,ait_real_128bit);
var
hp1 : tai;
lastlabel : tasmlabel;
realait : taitype;
hiloswapped : boolean;
begin
location_reset(location,LOC_CREFERENCE,def_cgsize(resulttype.def));
lastlabel:=nil;
realait:=floattype2ait[tfloatdef(resulttype.def).typ];
hiloswapped:=aktfputype in [fpu_fpa,fpu_fpa10,fpu_fpa11];
{ const already used ? }
if not assigned(lab_real) then
begin
objectlibrary.getjumplabel(lastlabel);
lab_real:=lastlabel;
current_procinfo.aktlocaldata.concat(Tai_label.Create(lastlabel));
location.reference.symboldata:=current_procinfo.aktlocaldata.last;
case realait of
ait_real_32bit :
begin
current_procinfo.aktlocaldata.concat(Tai_real_32bit.Create(ts32real(value_real)));
{ range checking? }
if ((cs_check_range in aktlocalswitches) or
(cs_check_overflow in aktlocalswitches)) and
(tai_real_32bit(asmlist[al_typedconsts].last).value=double(MathInf)) then
Message(parser_e_range_check_error);
end;
ait_real_64bit :
begin
if hiloswapped then
current_procinfo.aktlocaldata.concat(Tai_real_64bit.Create_hiloswapped(ts64real(value_real)))
else
current_procinfo.aktlocaldata.concat(Tai_real_64bit.Create(ts64real(value_real)));
{ range checking? }
if ((cs_check_range in aktlocalswitches) or
(cs_check_overflow in aktlocalswitches)) and
(tai_real_64bit(asmlist[al_typedconsts].last).value=double(MathInf)) then
Message(parser_e_range_check_error);
end;
ait_real_80bit :
begin
current_procinfo.aktlocaldata.concat(Tai_real_80bit.Create(value_real));
{ range checking? }
if ((cs_check_range in aktlocalswitches) or
(cs_check_overflow in aktlocalswitches)) and
(tai_real_80bit(asmlist[al_typedconsts].last).value=double(MathInf)) then
Message(parser_e_range_check_error);
end;
{$ifdef cpufloat128}
ait_real_128bit :
begin
current_procinfo.aktlocaldata.concat(Tai_real_128bit.Create(value_real));
{ range checking? }
if ((cs_check_range in aktlocalswitches) or
(cs_check_overflow in aktlocalswitches)) and
(tai_real_128bit(asmlist[al_typedconsts].last).value=double(MathInf)) then
Message(parser_e_range_check_error);
end;
{$endif cpufloat128}
{ the round is necessary for native compilers where comp isn't a float }
ait_comp_64bit :
if (value_real>9223372036854775807.0) or (value_real<-9223372036854775808.0) then
message(parser_e_range_check_error)
else
current_procinfo.aktlocaldata.concat(Tai_comp_64bit.Create(round(value_real)));
else
internalerror(2005092401);
end;
end;
location.reference.symbol:=lab_real;
location.reference.base:=NR_R15;
end;
begin
crealconstnode:=tarmrealconstnode;
end.