Przeglądaj źródła

+ sparc64 variants of the cpu specific files used by the rtl

git-svn-id: trunk@36514 -
florian 8 lat temu
rodzic
commit
a6c2f1660b
4 zmienionych plików z 162 dodań i 0 usunięć
  1. 3 0
      .gitattributes
  2. 123 0
      rtl/sparc64/mathu.inc
  3. 18 0
      rtl/sparc64/strings.inc
  4. 18 0
      rtl/sparc64/stringss.inc

+ 3 - 0
.gitattributes

@@ -9970,10 +9970,13 @@ rtl/sparc/stringss.inc svneol=native#text/plain
 rtl/sparc64/int64p.inc svneol=native#text/plain
 rtl/sparc64/makefile.cpu 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/setjump.inc svneol=native#text/plain
 rtl/sparc64/setjumph.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.fpc svneol=native#text/plain
 rtl/symbian/bindings/pbeexe.cpp -text

+ 123 - 0
rtl/sparc64/mathu.inc

@@ -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 - 0
rtl/sparc64/strings.inc

@@ -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 - 0
rtl/sparc64/stringss.inc

@@ -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.
+
+ **********************************************************************}
+
+