mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-13 04:19:31 +02:00
+ sparc64 variants of the cpu specific files used by the rtl
git-svn-id: trunk@36514 -
This commit is contained in:
parent
b8755b6b2c
commit
a6c2f1660b
3
.gitattributes
vendored
3
.gitattributes
vendored
@ -9970,10 +9970,13 @@ rtl/sparc/stringss.inc svneol=native#text/plain
|
|||||||
rtl/sparc64/int64p.inc svneol=native#text/plain
|
rtl/sparc64/int64p.inc svneol=native#text/plain
|
||||||
rtl/sparc64/makefile.cpu svneol=native#text/plain
|
rtl/sparc64/makefile.cpu svneol=native#text/plain
|
||||||
rtl/sparc64/math.inc svneol=native#text/plain
|
rtl/sparc64/math.inc svneol=native#text/plain
|
||||||
|
rtl/sparc64/mathu.inc svneol=native#text/plain
|
||||||
rtl/sparc64/set.inc svneol=native#text/plain
|
rtl/sparc64/set.inc svneol=native#text/plain
|
||||||
rtl/sparc64/setjump.inc svneol=native#text/plain
|
rtl/sparc64/setjump.inc svneol=native#text/plain
|
||||||
rtl/sparc64/setjumph.inc svneol=native#text/plain
|
rtl/sparc64/setjumph.inc svneol=native#text/plain
|
||||||
rtl/sparc64/sparc64.inc svneol=native#text/plain
|
rtl/sparc64/sparc64.inc svneol=native#text/plain
|
||||||
|
rtl/sparc64/strings.inc svneol=native#text/plain
|
||||||
|
rtl/sparc64/stringss.inc svneol=native#text/plain
|
||||||
rtl/symbian/Makefile svneol=native#text/plain
|
rtl/symbian/Makefile svneol=native#text/plain
|
||||||
rtl/symbian/Makefile.fpc svneol=native#text/plain
|
rtl/symbian/Makefile.fpc svneol=native#text/plain
|
||||||
rtl/symbian/bindings/pbeexe.cpp -text
|
rtl/symbian/bindings/pbeexe.cpp -text
|
||||||
|
123
rtl/sparc64/mathu.inc
Normal file
123
rtl/sparc64/mathu.inc
Normal file
@ -0,0 +1,123 @@
|
|||||||
|
{
|
||||||
|
This file is part of the Free Pascal run time library.
|
||||||
|
Copyright (c) 1999-2000 by Florian Klaempfl
|
||||||
|
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.
|
||||||
|
|
||||||
|
**********************************************************************}
|
||||||
|
|
||||||
|
{ exported by the system unit }
|
||||||
|
function get_fsr : dword;external name 'FPC_GETFSR';
|
||||||
|
procedure set_fsr(fsr : dword);external name 'FPC_SETFSR';
|
||||||
|
|
||||||
|
function GetRoundMode: TFPURoundingMode;
|
||||||
|
begin
|
||||||
|
result:=TFPURoundingMode(get_fsr shr 30);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
|
||||||
|
var
|
||||||
|
cw: dword;
|
||||||
|
begin
|
||||||
|
cw:=get_fsr;
|
||||||
|
result:=TFPURoundingMode(cw shr 30);
|
||||||
|
set_fsr((cw and $3fffffff) or (dword(RoundMode) shl 30));
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function GetPrecisionMode: TFPUPrecisionMode;
|
||||||
|
begin
|
||||||
|
result:=pmDouble;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function SetPrecisionMode(const Precision: TFPUPrecisionMode): TFPUPrecisionMode;
|
||||||
|
begin
|
||||||
|
result:=pmDouble;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function FSR2ExceptionMask(fsr: dword): TFPUExceptionMask;
|
||||||
|
begin
|
||||||
|
result:=[];
|
||||||
|
{ invalid operation: bit 27 }
|
||||||
|
if (fsr and (1 shl 27))=0 then
|
||||||
|
include(result,exInvalidOp);
|
||||||
|
|
||||||
|
{ zero divide: bit 24 }
|
||||||
|
if (fsr and (1 shl 24))=0 then
|
||||||
|
include(result,exZeroDivide);
|
||||||
|
|
||||||
|
{ overflow: bit 26 }
|
||||||
|
if (fsr and (1 shl 26))=0 then
|
||||||
|
include(result,exOverflow);
|
||||||
|
|
||||||
|
{ underflow: bit 25 }
|
||||||
|
if (fsr and (1 shl 25))=0 then
|
||||||
|
include(result,exUnderflow);
|
||||||
|
|
||||||
|
{ Precision (inexact result): bit 23 }
|
||||||
|
if (fsr and (1 shl 23))=0 then
|
||||||
|
include(result,exPrecision);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function GetExceptionMask: TFPUExceptionMask;
|
||||||
|
begin
|
||||||
|
result:=FSR2ExceptionMask(get_fsr);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
|
||||||
|
var
|
||||||
|
fsr : dword;
|
||||||
|
begin
|
||||||
|
fsr:=get_fsr;
|
||||||
|
result:=FSR2ExceptionMask(fsr);
|
||||||
|
|
||||||
|
{ invalid operation: bit 27 }
|
||||||
|
if (exInvalidOp in mask) then
|
||||||
|
fsr:=fsr and not(1 shl 27)
|
||||||
|
else
|
||||||
|
fsr:=fsr or (1 shl 27);
|
||||||
|
|
||||||
|
{ zero divide: bit 24 }
|
||||||
|
if (exZeroDivide in mask) then
|
||||||
|
fsr:=fsr and not(1 shl 24)
|
||||||
|
else
|
||||||
|
fsr:=fsr or (1 shl 24);
|
||||||
|
|
||||||
|
{ overflow: bit 26 }
|
||||||
|
if (exOverflow in mask) then
|
||||||
|
fsr:=fsr and not(1 shl 26)
|
||||||
|
else
|
||||||
|
fsr:=fsr or (1 shl 26);
|
||||||
|
|
||||||
|
{ underflow: bit 25 }
|
||||||
|
if (exUnderflow in mask) then
|
||||||
|
fsr:=fsr and not(1 shl 25)
|
||||||
|
else
|
||||||
|
fsr:=fsr or (1 shl 25);
|
||||||
|
|
||||||
|
{ Precision (inexact result): bit 23 }
|
||||||
|
if (exPrecision in mask) then
|
||||||
|
fsr:=fsr and not(1 shl 23)
|
||||||
|
else
|
||||||
|
fsr:=fsr or (1 shl 23);
|
||||||
|
|
||||||
|
{ update control register contents }
|
||||||
|
set_fsr(fsr);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure ClearExceptions(RaisePending: Boolean =true);
|
||||||
|
begin
|
||||||
|
set_fsr(get_fsr and $fffffc1f);
|
||||||
|
end;
|
||||||
|
|
18
rtl/sparc64/strings.inc
Normal file
18
rtl/sparc64/strings.inc
Normal file
@ -0,0 +1,18 @@
|
|||||||
|
{
|
||||||
|
This file is part of the Free Pascal run time library.
|
||||||
|
Copyright (c) 2000 by Jonas Maebe, member of the
|
||||||
|
Free Pascal development team
|
||||||
|
|
||||||
|
Processor dependent part of strings.pp, that can be shared with
|
||||||
|
sysutils unit.
|
||||||
|
|
||||||
|
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.
|
||||||
|
|
||||||
|
**********************************************************************}
|
||||||
|
|
||||||
|
|
18
rtl/sparc64/stringss.inc
Normal file
18
rtl/sparc64/stringss.inc
Normal file
@ -0,0 +1,18 @@
|
|||||||
|
{
|
||||||
|
This file is part of the Free Pascal run time library.
|
||||||
|
Copyright (c) 1999-2000 by Jonas Maebe, member of the
|
||||||
|
Free Pascal development team
|
||||||
|
|
||||||
|
Processor dependent part of strings.pp, not shared with
|
||||||
|
sysutils unit.
|
||||||
|
|
||||||
|
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.
|
||||||
|
|
||||||
|
**********************************************************************}
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user