1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
|
{
This file is part of the Free Pascal run time library.
Copyright (c) 2014 by Jonas Maebe
member of the Free Pascal development team
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
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.
**********************************************************************}
{$asmmode gas}
function getfpcr: dword; nostackframe; assembler;
asm
mrs x0,fpcr
end;
procedure setfpcr(val: dword); nostackframe; assembler;
asm
msr fpcr,x0
end;
function getfpsr: dword; nostackframe; assembler;
asm
mrs x0,fpsr
end;
procedure setfpsr(val: dword); nostackframe; assembler;
asm
msr fpsr, x0
end;
function GetRoundMode: TFPURoundingMode;
const
bits2rm: array[0..3] of TFPURoundingMode = (rmNearest,rmUp,rmDown,rmTruncate);
begin
result:=TFPURoundingMode(bits2rm[(getfpcr shr 22) and 3])
end;
function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
const
rm2bits: array[TFPURoundingMode] of byte = (0,2,1,3);
begin
softfloat_rounding_mode:=RoundMode;
SetRoundMode:=GetRoundMode;
setfpcr((getfpcr and $ff3fffff) or (rm2bits[RoundMode] shl 22));
end;
function GetPrecisionMode: TFPUPrecisionMode;
begin
result:=pmDouble;
end;
function SetPrecisionMode(const Precision: TFPUPrecisionMode): TFPUPrecisionMode;
begin
result:=pmDouble;
end;
const
fpu_ioe = 1 shl 8;
fpu_dze = 1 shl 9;
fpu_ofe = 1 shl 10;
fpu_ufe = 1 shl 11;
fpu_ixe = 1 shl 12;
fpu_ide = 1 shl 15;
fpu_exception_mask = fpu_ioe or fpu_dze or fpu_ofe or fpu_ufe or fpu_ixe or fpu_ide;
fpu_exception_mask_to_status_mask_shift = 8;
function GetExceptionMask: TFPUExceptionMask;
{
var
fpcr: dword;
}
begin
{ as I am not aware of any hardware exception supporting AArch64 implementation,
and else the trapping enable flags are RAZ, return the softfloat exception mask (FK)
fpcr:=getfpcr;
result:=[];
if ((fpcr and fpu_ioe)=0) then
result := result+[exInvalidOp];
if ((fpcr and fpu_ofe)=0) then
result := result+[exOverflow];
if ((fpcr and fpu_ufe)=0) then
result := result+[exUnderflow];
if ((fpcr and fpu_dze)=0) then
result := result+[exZeroDivide];
if ((fpcr and fpu_ixe)=0) then
result := result+[exPrecision];
if ((fpcr and fpu_ide)=0) then
result := result+[exDenormalized];
}
{ as the fpcr flags might be RAZ, the softfloat exception mask
is considered as the authoritative mask }
result:=softfloat_exception_mask;
end;
function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
var
newfpcr: dword;
begin
{ clear "exception happened" flags }
ClearExceptions(false);
softfloat_exception_mask:=mask;
{ at least the ThunderX AArch64 support apperently hardware exceptions,
so set fpcr correctly, thought it might be WI on most implementations it does not hurt
}
newfpcr:=fpu_exception_mask;
if exInvalidOp in Mask then
newfpcr:=newfpcr and not(fpu_ioe);
if exOverflow in Mask then
newfpcr:=newfpcr and not(fpu_ofe);
if exUnderflow in Mask then
newfpcr:=newfpcr and not(fpu_ufe);
if exZeroDivide in Mask then
newfpcr:=newfpcr and not(fpu_dze);
if exPrecision in Mask then
newfpcr:=newfpcr and not(fpu_ixe);
if exDenormalized in Mask then
newfpcr:=newfpcr and not(fpu_ide);
setfpcr((getfpcr and not(fpu_exception_mask)) or newfpcr);
{ as the fpcr flags might be RAZ, the softfloat exception mask
is considered as the authoritative mask }
result:=softfloat_exception_mask;
end;
procedure ClearExceptions(RaisePending: Boolean);
var
fpsr: dword;
f: TFPUException;
begin
fpsr:=getfpsr;
if raisepending then
begin
if (fpsr and (fpu_dze shr fpu_exception_mask_to_status_mask_shift)) <> 0 then
float_raise(exZeroDivide);
if (fpsr and (fpu_ofe shr fpu_exception_mask_to_status_mask_shift)) <> 0 then
float_raise(exOverflow);
if (fpsr and (fpu_ufe shr fpu_exception_mask_to_status_mask_shift)) <> 0 then
float_raise(exUnderflow);
if (fpsr and (fpu_ioe shr fpu_exception_mask_to_status_mask_shift)) <> 0 then
float_raise(exInvalidOp);
if (fpsr and (fpu_ixe shr fpu_exception_mask_to_status_mask_shift)) <> 0 then
float_raise(exPrecision);
if (fpsr and (fpu_ide shr fpu_exception_mask_to_status_mask_shift)) <> 0 then
float_raise(exDenormalized);
{ now the soft float exceptions }
for f in softfloat_exception_flags do
float_raise(f);
end;
softfloat_exception_flags:=[];
setfpsr(fpsr and not(fpu_exception_mask shr fpu_exception_mask_to_status_mask_shift));
end;
|
