paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 14:49:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

Fix problems with big endian systems without 80-bit floating point support

Browse Source 
git-svn-id: trunk@42906 -
This commit is contained in:
pierre 2019-09-02 16:00:15 +00:00
parent 57ac787370
commit 0e02b4f58c
1 changed files with 18 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
compiler/utils/ppuutils/ppudump.pp
View File

@ -491,17 +491,20 @@ type
case byte of case byte of
0: (bytes: Array[0..9] of byte); 0: (bytes: Array[0..9] of byte);
1: (words: Array[0..4] of word); 1: (words: Array[0..4] of word);
{$ifdef FPC_LITTLE_ENDIAN}
2: (cards: Array[0..1] of cardinal; w: word); 2: (cards: Array[0..1] of cardinal; w: word);
{$else not FPC_LITTLE_ENDIAN}
2: (w:word; cards: Array[0..1] of cardinal);
{$endif not FPC_LITTLE_ENDIAN}
end; end;
const const
maxDigits = 17; maxDigits = 17;
function Real80bitToStr(var e : TSplit80bitReal) : string; function Real80bitToStr(var e : TSplit80bitReal;var ext : extended) : string;
var var
Temp : string; Temp : string;
new : TSplit80bitReal; new : TSplit80bitReal;
fraczero, expmaximal, sign, outside_double : boolean; fraczero, expmaximal, sign, outside_double : boolean;
exp : smallint; exp : smallint;
ext : extended;
d : double; d : double;
i : longint; i : longint;
mantval : qword; mantval : qword;
@ -524,7 +527,11 @@ const
exp:=(e.w and $7fff) - 16383 - 63; exp:=(e.w and $7fff) - 16383 - 63;
fraczero := (e.cards[0] = 0) and fraczero := (e.cards[0] = 0) and
((e.cards[1] and $7fffffff) = 0); ((e.cards[1] and $7fffffff) = 0);
{$ifdef FPC_LITTLE_ENDIAN}
mantval := qword(e.cards[0]) or (qword(e.cards[1]) shl 32); mantval := qword(e.cards[0]) or (qword(e.cards[1]) shl 32);
{$else not FPC_LITTLE_ENDIAN}
mantval := (qword(e.cards[0]) shl 32) or qword(e.cards[1]);
{$endif not FPC_LITTLE_ENDIAN}
if expMaximal then if expMaximal then
if fraczero then if fraczero then
if sign then if sign then
@ -554,10 +561,15 @@ const
if (mantval<>0) and (d=0.0) then if (mantval<>0) and (d=0.0) then
outside_double:=true; outside_double:=true;
if outside_double then if outside_double then
Temp:='Extended value outside double bound' begin
Temp:='Extended value outside double bound';
ext:=0.0;
end
else else
system.str(d,temp); begin
ext:=d;
system.str(d,temp);
end;
end; end;
result:=temp; result:=temp;
@ -3600,8 +3612,7 @@ begin
else if entryleft=10 then else if entryleft=10 then
begin begin
getdata(extended,entryleft); getdata(extended,entryleft);
ss:=Real80bitToStr(extended); ss:=Real80bitToStr(extended,constdef.VFloat);
constdef.VFloat:=StrToFloat(ss);
writeln(ss); writeln(ss);
end end
else else