From a895e7bb7813214a22feccba3e718de95a052446 Mon Sep 17 00:00:00 2001 From: florian Date: Sat, 21 Feb 2004 22:53:49 +0000 Subject: [PATCH] * several 64 bit/x86-64 fixes --- rtl/objpas/typinfo.pp | 17 +++++++-- rtl/x86_64/mathu.inc | 81 +++++++++++++++++++++++++++++++++++++++++++ rtl/x86_64/mathuh.inc | 36 +++++++++++++++++++ 3 files changed, 131 insertions(+), 3 deletions(-) create mode 100644 rtl/x86_64/mathu.inc create mode 100644 rtl/x86_64/mathuh.inc diff --git a/rtl/objpas/typinfo.pp b/rtl/objpas/typinfo.pp index cc9e0c5757..a6e6844955 100644 --- a/rtl/objpas/typinfo.pp +++ b/rtl/objpas/typinfo.pp @@ -528,11 +528,11 @@ begin TP:=(@TD^.UnitName+Length(TD^.UnitName)+1); Count:=PWord(TP)^; // Now point TP to first propinfo record. - Inc(Longint(TP),SizeOF(Word)); + Inc(Pointer(TP),SizeOF(Word)); While Count>0 do begin PropList^[0]:=TP; - Inc(Longint(PropList),SizeOf(Pointer)); + Inc(Pointer(PropList),SizeOf(Pointer)); // Point to TP next propinfo record. // Located at Name[Length(Name)+1] ! TP:=PPropInfo(pointer(@TP^.Name)+PByte(@TP^.Name)^+1); @@ -788,7 +788,11 @@ end; Function GetObjectProp(Instance: TObject; PropInfo : PPropInfo; MinClass: TClass): TObject; begin +{$ifdef cpu64} + Result:=TObject(GetInt64Prop(Instance,PropInfo)); +{$else cpu64} Result:=TObject(GetOrdProp(Instance,PropInfo)); +{$endif cpu64} If (MinClass<>Nil) and (Result<>Nil) Then If Not Result.InheritsFrom(MinClass) then Result:=Nil; @@ -803,7 +807,11 @@ end; Procedure SetObjectProp(Instance: TObject; PropInfo : PPropInfo; Value: TObject); begin +{$ifdef cpu64} + SetInt64Prop(Instance,PropInfo,Int64(Value)); +{$else cpu64} SetOrdProp(Instance,PropInfo,Integer(Value)); +{$endif cpu64} end; @@ -1307,7 +1315,10 @@ end; end. { $Log$ - Revision 1.21 2004-02-20 15:55:26 peter + Revision 1.22 2004-02-21 22:53:49 florian + * several 64 bit/x86-64 fixes + + Revision 1.21 2004/02/20 15:55:26 peter * enable variant again Revision 1.20 2003/12/24 22:27:13 peter diff --git a/rtl/x86_64/mathu.inc b/rtl/x86_64/mathu.inc new file mode 100644 index 0000000000..98fc50fbfe --- /dev/null +++ b/rtl/x86_64/mathu.inc @@ -0,0 +1,81 @@ +{ + $Id$ + This file is part of the Free Pascal run time library. + Copyright (c) 1999-2004 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. + +**********************************************************************} + +{$define FPC_MATH_HAS_ARCTAN2} +function arctan2(y,x : float) : float;assembler; + asm + fldt y + fldt x + fpatan + fwait + end; + + +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(dword(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(dword(CtlWord and $3F)); +end; + +procedure ClearExceptions(RaisePending: Boolean);assembler; +asm + cmpb $0,RaisePending + je .Lclear + fwait +.Lclear: + fnclex +end; + +{ + $Log$ + Revision 1.1 2004-02-21 22:53:50 florian + * several 64 bit/x86-64 fixes +} diff --git a/rtl/x86_64/mathuh.inc b/rtl/x86_64/mathuh.inc new file mode 100644 index 0000000000..f7717c9320 --- /dev/null +++ b/rtl/x86_64/mathuh.inc @@ -0,0 +1,36 @@ +{ + $Id$ + This file is part of the Free Pascal run time library. + Copyright (c) 1999-2004 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. + + **********************************************************************} + +{ x86-64 fpu control word } +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}); + +{ + $Log$ + Revision 1.1 2004-02-21 22:53:50 florian + * several 64 bit/x86-64 fixes +}