mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 18:29:27 +02:00
+ "CExtended" type that is the same as "extended", but conforming to the
properties/behaviour of the equivalent of Extended in C (i.e., to
"long double" on i386 and x86_64 platforms that support a 10 byte
long double, and to "double" elsewhere)
git-svn-id: trunk@14912 -
This commit is contained in:
Jonas Maebe
parent
650ba6d50f
commit
025ec34e4d
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -8487,6 +8487,7 @@ tests/test/cg/taddr1.pp svneol=native#text/plain
|
||||
tests/test/cg/taddr2.pp svneol=native#text/plain
|
||||
tests/test/cg/taddreal1.pp svneol=native#text/plain
|
||||
tests/test/cg/taddreal2.pp svneol=native#text/plain
|
||||
tests/test/cg/taddreal3.pp svneol=native#text/plain
|
||||
tests/test/cg/taddset.pp svneol=native#text/plain
|
||||
tests/test/cg/taddset2.pp svneol=native#text/plain
|
||||
tests/test/cg/taddset3.pp svneol=native#text/plain
|
||||
|
||||
@ -465,7 +465,8 @@ interface
|
||||
{ Generates an extended float (80 bit real) }
|
||||
tai_real_80bit = class(tai)
|
||||
value : ts80real;
|
||||
constructor Create(_value : ts80real);
|
||||
savesize : byte;
|
||||
constructor Create(_value : ts80real; _savesize: byte);
|
||||
constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
|
||||
procedure ppuwrite(ppufile:tcompilerppufile);override;
|
||||
end;
|
||||
@ -1376,12 +1377,13 @@ implementation
|
||||
TAI_real_80bit
|
||||
****************************************************************************}
|
||||
|
||||
constructor tai_real_80bit.Create(_value : ts80real);
|
||||
constructor tai_real_80bit.Create(_value : ts80real; _savesize: byte);
|
||||
|
||||
begin
|
||||
inherited Create;
|
||||
typ:=ait_real_80bit;
|
||||
value:=_value;
|
||||
savesize:=_savesize;
|
||||
end;
|
||||
|
||||
|
||||
@ -1389,6 +1391,7 @@ implementation
|
||||
begin
|
||||
inherited ppuload(t,ppufile);
|
||||
value:=ppufile.getreal;
|
||||
savesize:=ppufile.getbyte;
|
||||
end;
|
||||
|
||||
|
||||
@ -1396,6 +1399,7 @@ implementation
|
||||
begin
|
||||
inherited ppuwrite(ppufile);
|
||||
ppufile.putreal(value);
|
||||
ppufile.putbyte(savesize);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
@ -913,6 +913,8 @@ implementation
|
||||
AsmWrite(',');
|
||||
AsmWrite(tostr(t80bitarray(e)[i]));
|
||||
end;
|
||||
for i:=11 to tai_real_80bit(hp).savesize do
|
||||
AsmWrite(',0');
|
||||
AsmLn;
|
||||
end;
|
||||
{$endif cpuextended}
|
||||
|
||||
@ -990,7 +990,7 @@ Implementation
|
||||
end;
|
||||
end;
|
||||
ait_real_80bit :
|
||||
ObjData.alloc(10);
|
||||
ObjData.alloc(tai_real_80bit(hp).savesize);
|
||||
ait_real_64bit :
|
||||
ObjData.alloc(8);
|
||||
ait_real_32bit :
|
||||
@ -1113,7 +1113,7 @@ Implementation
|
||||
end;
|
||||
end;
|
||||
ait_real_80bit :
|
||||
ObjData.alloc(10);
|
||||
ObjData.alloc(tai_real_80bit(hp).savesize);
|
||||
ait_real_64bit :
|
||||
ObjData.alloc(8);
|
||||
ait_real_32bit :
|
||||
@ -1232,7 +1232,10 @@ Implementation
|
||||
end;
|
||||
end;
|
||||
ait_real_80bit :
|
||||
ObjData.writebytes(Tai_real_80bit(hp).value,10);
|
||||
begin
|
||||
ObjData.writebytes(Tai_real_80bit(hp).value,10);
|
||||
ObjData.writebytes(zerobuf,Tai_real_80bit(hp).savesize-10);
|
||||
end;
|
||||
ait_real_64bit :
|
||||
ObjData.writebytes(Tai_real_64bit(hp).value,8);
|
||||
ait_real_32bit :
|
||||
|
||||
@ -268,7 +268,7 @@ interface
|
||||
1,2,4,8,16,1,2,4,8,16);
|
||||
|
||||
tfloat2tcgsize: array[tfloattype] of tcgsize =
|
||||
(OS_F32,OS_F64,OS_F80,OS_C64,OS_C64,OS_F128);
|
||||
(OS_F32,OS_F64,OS_F80,OS_F80,OS_C64,OS_C64,OS_F128);
|
||||
|
||||
tcgsize2tfloat: array[OS_F32..OS_C64] of tfloattype =
|
||||
(s32real,s64real,s80real,s64comp);
|
||||
|
||||
@ -1265,13 +1265,27 @@ implementation
|
||||
case def.floattype of
|
||||
s32real,
|
||||
s64real,
|
||||
s80real:
|
||||
s80real,
|
||||
sc80real:
|
||||
if assigned(def.typesym) then
|
||||
append_entry(DW_TAG_base_type,false,[
|
||||
DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
|
||||
DW_AT_encoding,DW_FORM_data1,DW_ATE_float,
|
||||
DW_AT_byte_size,DW_FORM_data1,def.size
|
||||
])
|
||||
begin
|
||||
append_entry(DW_TAG_base_type,false,[
|
||||
DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
|
||||
DW_AT_encoding,DW_FORM_data1,DW_ATE_float,
|
||||
DW_AT_byte_size,DW_FORM_data1,def.size
|
||||
]);
|
||||
if (def.floattype in [s80real,sc80real]) and
|
||||
(def.size<>10) then
|
||||
begin
|
||||
append_attribute(DW_AT_bit_size,DW_FORM_data1,[10*8]);
|
||||
{ "The bit offset attribute describes the offset in bits
|
||||
of the high order bit of a value of the given type
|
||||
from the high order bit of the storage unit used to
|
||||
contain that value." }
|
||||
if target_info.endian=endian_little then
|
||||
append_attribute(DW_AT_bit_offset,DW_FORM_data1,[(def.size-10)*8]);
|
||||
end;
|
||||
end
|
||||
else
|
||||
append_entry(DW_TAG_base_type,false,[
|
||||
DW_AT_encoding,DW_FORM_data1,DW_ATE_float,
|
||||
@ -2392,10 +2406,11 @@ implementation
|
||||
current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(8));
|
||||
current_asmdata.asmlists[al_dwarf_info].concat(tai_real_64bit.create(pdouble(sym.value.valueptr)^));
|
||||
end;
|
||||
s80real:
|
||||
s80real,
|
||||
sc80real:
|
||||
begin
|
||||
current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(10));
|
||||
current_asmdata.asmlists[al_dwarf_info].concat(tai_real_80bit.create(pextended(sym.value.valueptr)^));
|
||||
current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(sym.constdef.size));
|
||||
current_asmdata.asmlists[al_dwarf_info].concat(tai_real_80bit.create(pextended(sym.value.valueptr)^,sym.constdef.size));
|
||||
end;
|
||||
else
|
||||
internalerror(200601291);
|
||||
|
||||
@ -662,7 +662,8 @@ implementation
|
||||
case def.floattype of
|
||||
s32real,
|
||||
s64real,
|
||||
s80real:
|
||||
s80real,
|
||||
sc80real:
|
||||
ss:=def_stabstr_evaluate(def,'r$1;${savesize};0;',[def_stab_number(s32inttype)]);
|
||||
s64currency,
|
||||
s64comp:
|
||||
|
||||
@ -301,7 +301,7 @@ implementation
|
||||
function is_extended(def : tdef) : boolean;
|
||||
begin
|
||||
result:=(def.typ=floatdef) and
|
||||
(tfloatdef(def).floattype=s80real);
|
||||
(tfloatdef(def).floattype in [s80real,sc80real]);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
@ -426,9 +426,10 @@ interface
|
||||
tprocinfoflags=set of tprocinfoflag;
|
||||
|
||||
type
|
||||
{ float types }
|
||||
{ float types -- warning, this enum/order is used internally by the RTL
|
||||
as well in rtl/inc/real2str.inc }
|
||||
tfloattype = (
|
||||
s32real,s64real,s80real,
|
||||
s32real,s64real,s80real,sc80real { the C "long double" type on x86 },
|
||||
s64comp,s64currency,s128real
|
||||
);
|
||||
|
||||
|
||||
@ -2288,7 +2288,7 @@ implementation
|
||||
tve_chari64,tve_chari64,tve_dblcurrency);
|
||||
{ TODO: fixme for 128 bit floats }
|
||||
variantfloatdef_cl: array[tfloattype] of tvariantequaltype =
|
||||
(tve_single,tve_dblcurrency,tve_extended,
|
||||
(tve_single,tve_dblcurrency,tve_extended,tve_extended,
|
||||
tve_dblcurrency,tve_dblcurrency,tve_extended);
|
||||
variantstringdef_cl: array[tstringtype] of tvariantequaltype =
|
||||
(tve_sstring,tve_astring,tve_astring,tve_wstring,tve_ustring);
|
||||
|
||||
@ -732,6 +732,8 @@ interface
|
||||
AsmWrite(',');
|
||||
AsmWrite(tostr(t80bitarray(e)[i]));
|
||||
end;
|
||||
for i:=11 to tai_real_80bit(hp).savesize do
|
||||
AsmWrite(',0');
|
||||
AsmLn;
|
||||
end;
|
||||
{$else cpuextended}
|
||||
|
||||
@ -116,7 +116,7 @@ implementation
|
||||
function getbestreal(t1,t2 : tdef) : tdef;
|
||||
const
|
||||
floatweight : array[tfloattype] of byte =
|
||||
(2,3,4,0,1,5);
|
||||
(2,3,4,5,0,1,6);
|
||||
begin
|
||||
if t1.typ=floatdef then
|
||||
begin
|
||||
|
||||
@ -108,7 +108,7 @@ implementation
|
||||
{ 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);
|
||||
(ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_real_80bit,ait_comp_64bit,ait_comp_64bit,ait_real_128bit);
|
||||
var
|
||||
hp1 : tai;
|
||||
lastlabel : tasmlabel;
|
||||
@ -145,7 +145,7 @@ implementation
|
||||
((tai_real_64bit(hp1).formatoptions=fo_hiloswapped)=hiloswapped) and
|
||||
{$endif ARM}
|
||||
(tai_real_64bit(hp1).value=value_real) and is_number_float(tai_real_64bit(hp1).value) and (get_real_sign(value_real) = get_real_sign(tai_real_64bit(hp1).value))) or
|
||||
((realait=ait_real_80bit) and (tai_real_80bit(hp1).value=value_real) and is_number_float(tai_real_80bit(hp1).value) and (get_real_sign(value_real) = get_real_sign(tai_real_80bit(hp1).value))) or
|
||||
((realait=ait_real_80bit) and (tai_real_80bit(hp1).value=value_real) and (tai_real_80bit(hp1).savesize=resultdef.size) and is_number_float(tai_real_80bit(hp1).value) and (get_real_sign(value_real) = get_real_sign(tai_real_80bit(hp1).value))) or
|
||||
{$ifdef cpufloat128}
|
||||
((realait=ait_real_128bit) and (tai_real_128bit(hp1).value=value_real) and is_number_float(tai_real_128bit(hp1).value) and (get_real_sign(value_real) = get_real_sign(tai_real_128bit(hp1).value))) or
|
||||
{$endif cpufloat128}
|
||||
@ -196,7 +196,7 @@ implementation
|
||||
|
||||
ait_real_80bit :
|
||||
begin
|
||||
current_asmdata.asmlists[al_typedconsts].concat(Tai_real_80bit.Create(value_real));
|
||||
current_asmdata.asmlists[al_typedconsts].concat(Tai_real_80bit.Create(value_real,resultdef.size));
|
||||
|
||||
{ range checking? }
|
||||
if floating_point_range_check_error and
|
||||
|
||||
@ -535,9 +535,9 @@ implementation
|
||||
|
||||
procedure floatdef_rtti(def:tfloatdef);
|
||||
const
|
||||
{tfloattype = (s32real,s64real,s80real,s64bit,s128bit);}
|
||||
{tfloattype = (s32real,s64real,s80real,sc80real,s64bit,s128bit);}
|
||||
translate : array[tfloattype] of byte =
|
||||
(ftSingle,ftDouble,ftExtended,ftComp,ftCurr,ftFloat128);
|
||||
(ftSingle,ftDouble,ftExtended,ftExtended,ftComp,ftCurr,ftFloat128);
|
||||
begin
|
||||
current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkFloat));
|
||||
write_rtti_name(def);
|
||||
|
||||
@ -1887,7 +1887,7 @@ implementation
|
||||
procedure setfloatresultdef;
|
||||
begin
|
||||
if (left.resultdef.typ=floatdef) and
|
||||
(tfloatdef(left.resultdef).floattype in [s32real,s64real,s80real,s128real]) then
|
||||
(tfloatdef(left.resultdef).floattype in [s32real,s64real,s80real,sc80real,s128real]) then
|
||||
resultdef:=left.resultdef
|
||||
else
|
||||
begin
|
||||
@ -2463,7 +2463,7 @@ implementation
|
||||
set_varstate(left,vs_read,[vsf_must_be_valid]);
|
||||
{ for direct float rounding, no best real type cast should be necessary }
|
||||
if not((left.resultdef.typ=floatdef) and
|
||||
(tfloatdef(left.resultdef).floattype in [s32real,s64real,s80real,s128real])) and
|
||||
(tfloatdef(left.resultdef).floattype in [s32real,s64real,s80real,sc80real,s128real])) and
|
||||
{ converting an int64 to double on platforms without }
|
||||
{ extended can cause precision loss }
|
||||
not(left.nodetype in [ordconstn,realconstn]) then
|
||||
|
||||
@ -2413,6 +2413,7 @@ begin
|
||||
{$ifdef x86_64}
|
||||
def_system_macro('FPC_HAS_RIP_RELATIVE');
|
||||
{$endif x86_64}
|
||||
def_system_macro('FPC_HAS_CEXTENDED');
|
||||
|
||||
{ these cpus have an inline rol/ror implementaion }
|
||||
{$if defined(x86) or defined(arm) or defined(powerpc) or defined(powerpc64)}
|
||||
|
||||
@ -129,10 +129,12 @@ implementation
|
||||
s32floattype:=tfloatdef.create(s32real);
|
||||
s64floattype:=tfloatdef.create(s64real);
|
||||
s80floattype:=tfloatdef.create(s80real);
|
||||
sc80floattype:=tfloatdef.create(sc80real);
|
||||
end else begin
|
||||
s32floattype:=nil;
|
||||
s64floattype:=nil;
|
||||
s80floattype:=nil;
|
||||
sc80floattype:=nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -206,6 +208,7 @@ implementation
|
||||
s32floattype:=tfloatdef.create(s32real);
|
||||
s64floattype:=tfloatdef.create(s64real);
|
||||
s80floattype:=tfloatdef.create(s80real);
|
||||
sc80floattype:=tfloatdef.create(sc80real);
|
||||
s64currencytype:=torddef.create(scurrency,low(int64),high(int64));
|
||||
{$endif avr}
|
||||
{$ifdef cpu64bitaddr}
|
||||
@ -257,6 +260,12 @@ implementation
|
||||
addtype('Double',s64floattype);
|
||||
{ extended size is the best real type for the target }
|
||||
addtype('Extended',pbestrealtype^);
|
||||
{ CExtended corresponds to the C version of the Extended type
|
||||
(either "long double" or "double") }
|
||||
if tfloatdef(pbestrealtype^).floattype=s80real then
|
||||
addtype('CExtended',sc80floattype)
|
||||
else
|
||||
addtype('CExtended',pbestrealtype^);
|
||||
end;
|
||||
{$ifdef x86}
|
||||
if target_info.system<>system_x86_64_win64 then
|
||||
@ -334,6 +343,7 @@ implementation
|
||||
addtype('$s32real',s32floattype);
|
||||
addtype('$s64real',s64floattype);
|
||||
addtype('$s80real',s80floattype);
|
||||
addtype('$sc80real',sc80floattype);
|
||||
end;
|
||||
addtype('$s64currency',s64currencytype);
|
||||
{ Add a type for virtual method tables }
|
||||
@ -417,6 +427,7 @@ implementation
|
||||
loadtype('s32real',s32floattype);
|
||||
loadtype('s64real',s64floattype);
|
||||
loadtype('s80real',s80floattype);
|
||||
loadtype('sc80real',sc80floattype);
|
||||
end;
|
||||
loadtype('s64currency',s64currencytype);
|
||||
loadtype('boolean',booltype);
|
||||
|
||||
@ -312,7 +312,9 @@ implementation
|
||||
{$endif ARM}
|
||||
list.concat(Tai_real_64bit.Create(ts64real(value)));
|
||||
s80real :
|
||||
list.concat(Tai_real_80bit.Create(value));
|
||||
list.concat(Tai_real_80bit.Create(value,s80floattype.size));
|
||||
sc80real :
|
||||
list.concat(Tai_real_80bit.Create(value,sc80floattype.size));
|
||||
s64comp :
|
||||
{ the round is necessary for native compilers where comp isn't a float }
|
||||
list.concat(Tai_comp_64bit.Create(round(value)));
|
||||
|
||||
@ -51,7 +51,7 @@ unit raatt;
|
||||
{------------------ Assembler directives --------------------}
|
||||
AS_DB,AS_DW,AS_DD,AS_DQ,AS_GLOBAL,
|
||||
AS_ALIGN,AS_BALIGN,AS_P2ALIGN,AS_ASCII,
|
||||
AS_ASCIIZ,AS_LCOMM,AS_COMM,AS_SINGLE,AS_DOUBLE,AS_EXTENDED,
|
||||
AS_ASCIIZ,AS_LCOMM,AS_COMM,AS_SINGLE,AS_DOUBLE,AS_EXTENDED,AS_CEXTENDED,
|
||||
AS_DATA,AS_TEXT,AS_INIT,AS_FINI,AS_END,
|
||||
{------------------ Assembler Operators --------------------}
|
||||
AS_TYPE,AS_SIZEOF,AS_VMTOFFSET,AS_MOD,AS_SHL,AS_SHR,AS_NOT,AS_AND,AS_OR,AS_XOR,AS_NOR,AS_AT,
|
||||
@ -73,7 +73,7 @@ unit raatt;
|
||||
'#','{','}','[',']',
|
||||
'.byte','.word','.long','.quad','.globl',
|
||||
'.align','.balign','.p2align','.ascii',
|
||||
'.asciz','.lcomm','.comm','.single','.double','.tfloat',
|
||||
'.asciz','.lcomm','.comm','.single','.double','.tfloat','.tcfloat',
|
||||
'.data','.text','.init','.fini','END',
|
||||
'TYPE','SIZEOF','VMTOFFSET','%','<<','>>','!','&','|','^','~','@','lo','hi');
|
||||
|
||||
@ -1034,6 +1034,12 @@ unit raatt;
|
||||
BuildRealConstant(s80real);
|
||||
end;
|
||||
|
||||
AS_CEXTENDED:
|
||||
Begin
|
||||
Consume(AS_CEXTENDED);
|
||||
BuildRealConstant(sc80real);
|
||||
end;
|
||||
|
||||
AS_GLOBAL:
|
||||
Begin
|
||||
Consume(AS_GLOBAL);
|
||||
|
||||
@ -1565,7 +1565,8 @@ end;
|
||||
else
|
||||
{$endif ARM}
|
||||
p.concat(Tai_real_64bit.Create(value));
|
||||
s80real : p.concat(Tai_real_80bit.Create(value));
|
||||
s80real : p.concat(Tai_real_80bit.Create(value,s80floattype.size));
|
||||
sc80real : p.concat(Tai_real_80bit.Create(value,sc80floattype.size));
|
||||
s64comp : p.concat(Tai_comp_64bit.Create(trunc(value)));
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -647,9 +647,10 @@ interface
|
||||
s32inttype, { 32-Bit signed integer }
|
||||
u64inttype, { 64-bit unsigned integer }
|
||||
s64inttype, { 64-bit signed integer }
|
||||
s32floattype, { pointer for realconstn }
|
||||
s64floattype, { pointer for realconstn }
|
||||
s80floattype, { pointer to type of temp. floats }
|
||||
s32floattype, { 32 bit floating point number }
|
||||
s64floattype, { 64 bit floating point number }
|
||||
s80floattype, { 80 bit floating point number }
|
||||
sc80floattype, { 80 bit floating point number but stored like in C }
|
||||
s64currencytype, { pointer to a currency type }
|
||||
cshortstringtype, { pointer to type of short string const }
|
||||
clongstringtype, { pointer to type of long string const }
|
||||
@ -1717,7 +1718,7 @@ implementation
|
||||
begin
|
||||
if (target_info.system in [system_i386_darwin,system_arm_darwin]) then
|
||||
case floattype of
|
||||
s80real : result:=16;
|
||||
s80real: result:=16;
|
||||
s64real,
|
||||
s64currency,
|
||||
s64comp : result:=4;
|
||||
@ -1734,6 +1735,13 @@ implementation
|
||||
case floattype of
|
||||
s32real : savesize:=4;
|
||||
s80real : savesize:=10;
|
||||
sc80real:
|
||||
if target_info.system in [system_i386_darwin,system_x86_64_darwin,
|
||||
system_x86_64_linux,system_x86_64_freebsd,
|
||||
system_x86_64_solaris,system_x86_64_embedded] then
|
||||
savesize:=16
|
||||
else
|
||||
savesize:=12;
|
||||
s64real,
|
||||
s64currency,
|
||||
s64comp : savesize:=8;
|
||||
@ -1746,7 +1754,7 @@ implementation
|
||||
function tfloatdef.getvardef : longint;
|
||||
const
|
||||
floattype2vardef : array[tfloattype] of longint = (
|
||||
varSingle,varDouble,varUndefined,
|
||||
varSingle,varDouble,varUndefined,varUndefined,
|
||||
varUndefined,varCurrency,varUndefined);
|
||||
begin
|
||||
if (upper(typename)='TDATETIME') and
|
||||
@ -1776,7 +1784,7 @@ implementation
|
||||
function tfloatdef.GetTypeName : string;
|
||||
const
|
||||
names : array[tfloattype] of string[20] = (
|
||||
'Single','Double','Extended','Comp','Currency','Float128');
|
||||
'Single','Double','Extended','CExtended','Comp','Currency','Float128');
|
||||
begin
|
||||
GetTypeName:=names[floattype];
|
||||
end;
|
||||
@ -3474,7 +3482,7 @@ implementation
|
||||
'c','w','x');
|
||||
|
||||
floattype2str : array[tfloattype] of string[1] = (
|
||||
'f','d','e',
|
||||
'f','d','e','e',
|
||||
'd','d','g');
|
||||
{$endif NAMEMANGLING_GCC2}
|
||||
|
||||
|
||||
@ -89,7 +89,8 @@ unit cpupara;
|
||||
floatdef:
|
||||
begin
|
||||
case tfloatdef(p).floattype of
|
||||
s80real:
|
||||
s80real,
|
||||
sc80real:
|
||||
loc1:=LOC_REFERENCE;
|
||||
s32real,
|
||||
s64real :
|
||||
@ -438,7 +439,8 @@ unit cpupara;
|
||||
end;
|
||||
s64currency,
|
||||
s64comp,
|
||||
s80real:
|
||||
s80real,
|
||||
sc80real:
|
||||
begin
|
||||
result.loc:=LOC_FPUREGISTER;
|
||||
result.register:=NR_FPU_RESULT_REG;
|
||||
|
||||
@ -95,19 +95,11 @@ type
|
||||
{$endif}
|
||||
|
||||
{$ifndef FPUNONE}
|
||||
{$ifdef longdouble_is_double}
|
||||
{$if defined(longdouble_is_double) or not defined(FPC_HAS_CEXTENDED)}
|
||||
clongdouble=double;
|
||||
{$else}
|
||||
{$if defined(cpui386) or defined(cpux86_64)}
|
||||
{$define longdouble_assignment_overload_real80}
|
||||
clongdouble = packed record
|
||||
value:extended;
|
||||
{$ifdef defined(cpu64) or defined(darwin)}
|
||||
padding:array[0..5] of byte;
|
||||
{$else}
|
||||
padding:array[0..1] of byte;
|
||||
{$endif}
|
||||
end;
|
||||
{$if defined(cpui386) or defined(cpux86_64) or defined(cpuavr)}
|
||||
clongdouble = cextended;
|
||||
{$else}
|
||||
{$define longdouble_assignment_overload_real128}
|
||||
clongdouble = packed array [0..15] of byte;
|
||||
@ -115,29 +107,6 @@ type
|
||||
{$endif}
|
||||
Pclongdouble=^clongdouble;
|
||||
|
||||
{$ifdef longdouble_assignment_overload_real80}
|
||||
operator := (const v:clongdouble) r:extended;inline;
|
||||
operator := (const v:extended) r:clongdouble;inline;
|
||||
operator +(const e:Extended;const c:clongdouble) r:extended;inline;
|
||||
operator +(const c:clongdouble;const e:Extended) r:extended;inline;
|
||||
operator -(const e:Extended;const c:clongdouble) r:extended;inline;
|
||||
operator -(const c:clongdouble;const e:Extended) r:extended;inline;
|
||||
operator *(const e:Extended;const c:clongdouble) r:extended;inline;
|
||||
operator *(const c:clongdouble;const e:Extended) r:extended;inline;
|
||||
operator /(const e:Extended;const c:clongdouble) r:extended;inline;
|
||||
operator /(const c:clongdouble;const e:Extended) r:extended;inline;
|
||||
operator =(const e:Extended;const c:clongdouble) r:boolean;inline;
|
||||
operator =(const c:clongdouble;const e:Extended) r:boolean;inline;
|
||||
operator <(const e:Extended;const c:clongdouble) r:boolean;inline;
|
||||
operator <(const c:clongdouble;const e:Extended) r:boolean;inline;
|
||||
operator >(const e:Extended;const c:clongdouble) r:boolean;inline;
|
||||
operator >(const c:clongdouble;const e:Extended) r:boolean;inline;
|
||||
operator >=(const e:Extended;const c:clongdouble) r:boolean;inline;
|
||||
operator >=(const c:clongdouble;const e:Extended) r:boolean;inline;
|
||||
operator <=(const e:Extended;const c:clongdouble) r:boolean;inline;
|
||||
operator <=(const c:clongdouble;const e:Extended) r:boolean;inline;
|
||||
{$endif}
|
||||
|
||||
{$ifdef longdouble_assignment_overload_real128}
|
||||
{Non-x86 typically doesn't have extended. To be fixed once this changes.}
|
||||
operator := (const v:clongdouble) r:double;inline;
|
||||
@ -168,109 +137,6 @@ operator <=(const c:clongdouble;const e:Double) r:boolean;inline;
|
||||
implementation
|
||||
|
||||
{$ifndef FPUNONE}
|
||||
{$ifdef longdouble_assignment_overload_real80}
|
||||
operator := (const v:clongdouble) r:extended;
|
||||
|
||||
begin
|
||||
r:=v.value;
|
||||
end;
|
||||
|
||||
operator := (const v:extended) r:clongdouble;
|
||||
|
||||
begin
|
||||
r.value:=v;
|
||||
end;
|
||||
|
||||
operator +(const e:Extended;const c:clongdouble) r:extended;inline;
|
||||
begin
|
||||
r:=e+c.value;
|
||||
end;
|
||||
|
||||
operator +(const c:clongdouble;const e:Extended) r:extended;inline;
|
||||
begin
|
||||
r:=c.value+e;
|
||||
end;
|
||||
|
||||
operator -(const e:Extended;const c:clongdouble) r:extended;inline;
|
||||
begin
|
||||
r:=e-c.value;
|
||||
end;
|
||||
|
||||
operator -(const c:clongdouble;const e:Extended) r:extended;inline;
|
||||
begin
|
||||
r:=c.value-e;
|
||||
end;
|
||||
|
||||
operator *(const e:Extended;const c:clongdouble) r:extended;inline;
|
||||
begin
|
||||
r:=e*c.value;
|
||||
end;
|
||||
|
||||
operator *(const c:clongdouble;const e:Extended) r:extended;inline;
|
||||
begin
|
||||
r:=c.value*e;
|
||||
end;
|
||||
|
||||
operator /(const e:Extended;const c:clongdouble) r:extended;inline;
|
||||
begin
|
||||
r:=e/c.value;
|
||||
end;
|
||||
|
||||
operator /(const c:clongdouble;const e:Extended) r:extended;inline;
|
||||
begin
|
||||
r:=c.value/e;
|
||||
end;
|
||||
|
||||
operator =(const e:Extended;const c:clongdouble) r:boolean;inline;
|
||||
begin
|
||||
r:=e=c.value;
|
||||
end;
|
||||
|
||||
operator =(const c:clongdouble;const e:Extended) r:boolean;inline;
|
||||
begin
|
||||
r:=c.value=e;
|
||||
end;
|
||||
|
||||
operator <(const e:Extended;const c:clongdouble) r:boolean;inline;
|
||||
begin
|
||||
r:=e<c.value;
|
||||
end;
|
||||
|
||||
operator <(const c:clongdouble;const e:Extended) r:boolean;inline;
|
||||
begin
|
||||
r:=c.value<e;
|
||||
end;
|
||||
|
||||
operator >(const e:Extended;const c:clongdouble) r:boolean;inline;
|
||||
begin
|
||||
r:=e>c.value;
|
||||
end;
|
||||
|
||||
operator >(const c:clongdouble;const e:Extended) r:boolean;inline;
|
||||
begin
|
||||
r:=c.value>e;
|
||||
end;
|
||||
|
||||
operator >=(const e:Extended;const c:clongdouble) r:boolean;inline;
|
||||
begin
|
||||
r:=e>=c.value;
|
||||
end;
|
||||
|
||||
operator >=(const c:clongdouble;const e:Extended) r:boolean;inline;
|
||||
begin
|
||||
r:=c.value>=e;
|
||||
end;
|
||||
|
||||
operator <=(const e:Extended;const c:clongdouble) r:boolean;inline;
|
||||
begin
|
||||
r:=e<=c.value;
|
||||
end;
|
||||
|
||||
operator <=(const c:clongdouble;const e:Extended) r:boolean;inline;
|
||||
begin
|
||||
r:=c.value<=e;
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
{$ifdef longdouble_assignment_overload_real128}
|
||||
|
||||
|
||||
@ -15,7 +15,7 @@
|
||||
type
|
||||
{ See symconst.pas tfloattype }
|
||||
treal_type = (
|
||||
rt_s32real,rt_s64real,rt_s80real,
|
||||
rt_s32real,rt_s64real,rt_s80real,rt_sc80real,
|
||||
rt_c64bit,rt_currency,rt_s128real
|
||||
);
|
||||
{ corresponding to single double extended fixed comp for i386 }
|
||||
@ -199,7 +199,8 @@ begin
|
||||
minlen:=9;
|
||||
explen:=5;
|
||||
end;
|
||||
rt_s80real :
|
||||
rt_s80real,
|
||||
rt_sc80real:
|
||||
begin
|
||||
{ Different in TP help, but this way the output is the same (JM) }
|
||||
maxlen:=25;
|
||||
|
||||
263
tests/test/cg/taddreal3.pp
Normal file
263
tests/test/cg/taddreal3.pp
Normal file
@ -0,0 +1,263 @@
|
||||
{****************************************************************}
|
||||
{ CODE GENERATOR TEST PROGRAM }
|
||||
{****************************************************************}
|
||||
{ NODE TESTED : secondadd() FPU cextended type code }
|
||||
{****************************************************************}
|
||||
{ PRE-REQUISITES: secondload() }
|
||||
{ secondassign() }
|
||||
{ secondtypeconv() }
|
||||
{****************************************************************}
|
||||
{ DEFINES: }
|
||||
{ FPC = Target is FreePascal compiler }
|
||||
{****************************************************************}
|
||||
{ REMARKS: }
|
||||
{ }
|
||||
{ }
|
||||
{ }
|
||||
{****************************************************************}
|
||||
|
||||
{ Result is either LOC_FPU or LOC_REFERENCE }
|
||||
{ LEFT NODE (operand) (left operator) }
|
||||
{ LOC_REFERENCE / LOC_MEM }
|
||||
{ LOC_FPU }
|
||||
{ RIGHT NODE (operand) }
|
||||
{ LOC_FPU }
|
||||
{ LOC_REFERENCE / LOC_MEM }
|
||||
procedure fail;
|
||||
begin
|
||||
WriteLn('Failed!');
|
||||
halt(1);
|
||||
end;
|
||||
|
||||
|
||||
Procedure RealTestSub;
|
||||
var
|
||||
i : cextended;
|
||||
j : cextended;
|
||||
result : boolean;
|
||||
Begin
|
||||
Write('cextended - cextended test...');
|
||||
result := true;
|
||||
i:=99.9;
|
||||
j:=10.0;
|
||||
i:=i-j;
|
||||
if trunc(i) <> trunc(89.9) then
|
||||
result := false;
|
||||
WriteLn('Result (89.9) :',i);
|
||||
i:=j-i;
|
||||
if trunc(i) <> trunc(-79.9) then
|
||||
result := false;
|
||||
WriteLn('Result (-79.9) :',i);
|
||||
j:=j-10.0;
|
||||
if j <> 0.0 then
|
||||
result := false;
|
||||
WriteLn('Result (0.0) :',j);
|
||||
if not result then
|
||||
Fail
|
||||
else
|
||||
WriteLn('Success.');
|
||||
end;
|
||||
|
||||
procedure RealTestAdd;
|
||||
var
|
||||
i : cextended;
|
||||
j : cextended;
|
||||
result : boolean;
|
||||
Begin
|
||||
WriteLn('cextended + cextended test...');
|
||||
result := true;
|
||||
i:= 9;
|
||||
i:=i+1.5;
|
||||
if trunc(i) <> trunc(10.5) then
|
||||
result := false;
|
||||
WriteLn('Result (10.5) :',i);
|
||||
i := 0.0;
|
||||
j := 100.0;
|
||||
i := i + j + j + 12.5;
|
||||
if trunc(i) <> trunc(212.5) then
|
||||
result := false;
|
||||
WriteLn('Result (212.5) :',i);
|
||||
if not result then
|
||||
Fail
|
||||
else
|
||||
WriteLn('Success.');
|
||||
end;
|
||||
|
||||
|
||||
procedure realtestmul;
|
||||
var
|
||||
i : cextended;
|
||||
j : cextended;
|
||||
result : boolean;
|
||||
begin
|
||||
WriteLn('cextended * cextended test...');
|
||||
result := true;
|
||||
i:= 0;
|
||||
j:= 0;
|
||||
i := i * j * i;
|
||||
if trunc(i) <> trunc(0.0) then
|
||||
result := false;
|
||||
WriteLn('Result (0.0) :',i);
|
||||
i := 10.0;
|
||||
j := -12.0;
|
||||
i := i * j * 10.0;
|
||||
if trunc(i) <> trunc(-1200.0) then
|
||||
result := false;
|
||||
WriteLn('Result (-1200.0) :',i);
|
||||
if not result then
|
||||
Fail
|
||||
else
|
||||
WriteLn('Success.');
|
||||
end;
|
||||
|
||||
|
||||
|
||||
Procedure RealTestDiv;
|
||||
var
|
||||
i : cextended;
|
||||
j : cextended;
|
||||
result : boolean;
|
||||
Begin
|
||||
result := true;
|
||||
WriteLn('cextended / cextended test...');
|
||||
i:=-99.9;
|
||||
j:=10.0;
|
||||
i:=i / j;
|
||||
if trunc(i) <> trunc(-9.9) then
|
||||
result := false;
|
||||
WriteLn('Result (-9.9) :',i);
|
||||
i:=j / i;
|
||||
if trunc(i) <> trunc(-1.01) then
|
||||
result := false;
|
||||
WriteLN('Result (-1.01) :',i);
|
||||
j:=i / 10.0;
|
||||
if trunc(j) <> trunc(-0.1001) then
|
||||
result := false;
|
||||
WriteLn('Result (-0.1001) :',j);
|
||||
if not result then
|
||||
Fail
|
||||
else
|
||||
WriteLn('Success.');
|
||||
end;
|
||||
|
||||
|
||||
|
||||
{ Procedure RealTestComplex;
|
||||
var
|
||||
i : cextended;
|
||||
Begin
|
||||
Write('RESULT SHOULD BE 2.09 :');
|
||||
i := 4.4;
|
||||
WriteLn(Sqrt(i));
|
||||
Write('RESULT SHOULD BE PI :');
|
||||
WriteLn(Pi);
|
||||
Write('RESULT SHOULD BE 4.0 :');
|
||||
WriteLn(Round(3.6));
|
||||
end;}
|
||||
|
||||
|
||||
procedure realtestequal;
|
||||
var
|
||||
i : cextended;
|
||||
j : cextended;
|
||||
result : boolean;
|
||||
begin
|
||||
result := true;
|
||||
Write('cextended = cextended test...');
|
||||
i := 1000.0;
|
||||
j := 1000.0;
|
||||
if not (trunc(i) = trunc(j)) then
|
||||
result := false;
|
||||
if not (trunc(i) = trunc(1000.0)) then
|
||||
result := false;
|
||||
if not result then
|
||||
Fail
|
||||
else
|
||||
WriteLn('Success.');
|
||||
end;
|
||||
|
||||
procedure realtestnotequal;
|
||||
var
|
||||
i : cextended;
|
||||
j : cextended;
|
||||
result : boolean;
|
||||
begin
|
||||
result := true;
|
||||
Write('cextended <> cextended test...');
|
||||
i := 1000.0;
|
||||
j := 1000.0;
|
||||
if (trunc(i) <> trunc(j)) then
|
||||
result := false;
|
||||
if (trunc(i) <> trunc(1000.0)) then
|
||||
result := false;
|
||||
if not result then
|
||||
Fail
|
||||
else
|
||||
WriteLn('Success.');
|
||||
end;
|
||||
|
||||
|
||||
procedure realtestle;
|
||||
var
|
||||
i : cextended;
|
||||
j : cextended;
|
||||
result : boolean;
|
||||
begin
|
||||
result := true;
|
||||
Write('cextended <= cextended test...');
|
||||
i := 1000.0;
|
||||
j := 1000.0;
|
||||
if not (trunc(i) <= trunc(j)) then
|
||||
result := false;
|
||||
if not (trunc(i) <= trunc(1000.0)) then
|
||||
result := false;
|
||||
i := 10000.0;
|
||||
j := 999.0;
|
||||
if trunc(i) < trunc(j) then
|
||||
result := false;
|
||||
if trunc(i) < trunc(999.0) then
|
||||
result := false;
|
||||
if not result then
|
||||
Fail
|
||||
else
|
||||
WriteLn('Success.');
|
||||
end;
|
||||
|
||||
procedure realtestge;
|
||||
var
|
||||
i : cextended;
|
||||
j : cextended;
|
||||
result : boolean;
|
||||
begin
|
||||
result := true;
|
||||
Write('cextended >= cextended test...');
|
||||
i := 1000.0;
|
||||
j := 1000.0;
|
||||
if not (trunc(i) >= trunc(j)) then
|
||||
result := false;
|
||||
if not (trunc(i) >= trunc(1000.0)) then
|
||||
result := false;
|
||||
i := 999.0;
|
||||
j := 1000.0;
|
||||
if trunc(i) > trunc(j) then
|
||||
result := false;
|
||||
if trunc(i) > trunc(999.0) then
|
||||
result := false;
|
||||
if not result then
|
||||
Fail
|
||||
else
|
||||
WriteLn('Success.');
|
||||
end;
|
||||
|
||||
|
||||
Begin
|
||||
RealTestEqual;
|
||||
RealTestNotEqual;
|
||||
RealTestLE;
|
||||
RealTestGE;
|
||||
RealTestSub;
|
||||
RealTestAdd;
|
||||
RealTestDiv;
|
||||
RealTestMul;
|
||||
{ RealTestComplex;}
|
||||
end.
|
||||
@ -25,7 +25,7 @@ uses strings,ctypes;
|
||||
{$endif USE_PASCAL_OBJECT}
|
||||
|
||||
{$ifdef FPC_HAS_TYPE_EXTENDED}
|
||||
{define test_longdouble}
|
||||
{$define test_longdouble}
|
||||
{$endif}
|
||||
|
||||
{ Use C alignment of records }
|
||||
@ -407,17 +407,8 @@ begin
|
||||
array_long_double[1] := RESULT_LONGDOUBLE;
|
||||
test_array_param_longdouble(array_long_double);
|
||||
if trunc(global_long_double) <> trunc(RESULT_LONGDOUBLE) then
|
||||
begin
|
||||
{$ifdef cpui386}
|
||||
if sizeof(global_long_double)=10 then
|
||||
begin
|
||||
{ Known issue, ignore tcalext2 contains that test }
|
||||
end
|
||||
else
|
||||
{$endif cpui386}
|
||||
failed := true;
|
||||
end;
|
||||
{$endif}
|
||||
failed := true;
|
||||
{$endif test_longdouble}
|
||||
|
||||
If failed then
|
||||
fail
|
||||
|
||||
Loading…
Reference in New Issue
Block a user