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

* i386 fpu controlword functions added

Browse Source
This commit is contained in:
peter 2003-01-03 20:34:02 +00:00
parent 133a9aa958
commit 892e9c864a
3 changed files with 112 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
rtl/i386/math.inc
View File

@ -14,6 +14,24 @@
**********************************************************************}
{****************************************************************************
FPU Control word
****************************************************************************}
procedure Set8087CW(cw:word);assembler;
asm
movw cw,%ax
movw %ax,default8087cw
fnclex
fldcw default8087cw
end;
function Get8087CW:word;assembler;
asm
pushl $0
fnstcw (%esp)
popl %eax
end;
{****************************************************************************
EXTENDED data type routines
@ -204,7 +222,10 @@
{
$Log$
Revision 1.9 2002-10-06 21:26:17 peter
Revision 1.10 2003-01-03 20:34:02 peter
* i386 fpu controlword functions added
Revision 1.9 2002/10/06 21:26:17 peter
* round returns int64
Revision 1.8 2002/09/07 16:01:19 peter

15
rtl/inc/mathh.inc
View File

@ -13,6 +13,16 @@
**********************************************************************}
{ i386 FPU Controlword }
{$ifdef cpui386}
const
Default8087CW : word = $1332;
procedure Set8087CW(cw:word);
function Get8087CW:word;
{$endif cpui386}
{ declarations of the math routines }
function abs(d : extended) : extended;
@ -44,7 +54,10 @@
{
$Log$
Revision 1.9 2002-10-06 21:26:18 peter
Revision 1.10 2003-01-03 20:34:02 peter
* i386 fpu controlword functions added
Revision 1.9 2002/10/06 21:26:18 peter
* round returns int64
Revision 1.8 2002/09/07 15:07:45 peter

77
rtl/objpas/math.pp
View File

@ -210,6 +210,24 @@ procedure momentskewkurtosis(const data : PFloat; Const N : Integer;
function norm(const data : array of float) : float;
function norm(const data : PFloat; Const N : Integer) : float;
{ i386 fpu control word }
{$ifdef cpui386}
type
TFPURoundingMode = (rmNearest, rmDown, rmUp, rmTruncate);
TFPUPrecisionMode = (pmSingle, pmReserved, pmDouble, pmExtended);
TFPUException = (exInvalidOp, exDenormalized, exZeroDivide,
exOverflow, exUnderflow, exPrecision);
TFPUExceptionMask = set of TFPUException;
function GetRoundMode: TFPURoundingMode;
function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
function GetPrecisionMode: TFPUPrecisionMode;
function SetPrecisionMode(const Precision: TFPUPrecisionMode): TFPUPrecisionMode;
function GetExceptionMask: TFPUExceptionMask;
function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
procedure ClearExceptions(RaisePending: Boolean {$ifndef VER1_0}=true{$endif});
{$endif cpui386}
implementation
ResourceString
@ -932,11 +950,68 @@ begin
Result := b;
end;
{$ifdef cpui386}
function GetRoundMode: TFPURoundingMode;
begin
Result := TFPURoundingMode((Get8087CW shr 10) and 3);
end;
function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
var
CtlWord: Word;
begin
CtlWord := Get8087CW;
Set8087CW((CtlWord and $F3FF) or (Ord(RoundMode) shl 10));
Result := TFPURoundingMode((CtlWord shr 10) and 3);
end;
function GetPrecisionMode: TFPUPrecisionMode;
begin
Result := TFPUPrecisionMode((Get8087CW shr 8) and 3);
end;
function SetPrecisionMode(const Precision: TFPUPrecisionMode): TFPUPrecisionMode;
var
CtlWord: Word;
begin
CtlWord := Get8087CW;
Set8087CW((CtlWord and $FCFF) or (Ord(Precision) shl 8));
Result := TFPUPrecisionMode((CtlWord shr 8) and 3);
end;
function GetExceptionMask: TFPUExceptionMask;
begin
Result := TFPUExceptionMask(Get8087CW and $3F);
end;
function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
var
CtlWord: Word;
begin
CtlWord := Get8087CW;
Set8087CW( (CtlWord and $FFC0) or Byte(Longint(Mask)) );
Result := TFPUExceptionMask(CtlWord and $3F);
end;
procedure ClearExceptions(RaisePending: Boolean);assembler;
asm
cmpb $0,RaisePending
je .Lclear
fwait
.Lclear:
fnclex
end;
{$endif cpui386}
end.
{
$Log$
Revision 1.8 2002-09-07 21:06:12 carl
Revision 1.9 2003-01-03 20:34:02 peter
* i386 fpu controlword functions added
Revision 1.8 2002/09/07 21:06:12 carl
* cleanup of parameters
- remove assembler code