* several 64 bit/x86-64 fixes

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

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
+}

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
+}