Bladeren bron

* several 64 bit issues fixed

florian 21 jaren geleden
bovenliggende
commit
934fe41c45
5 gewijzigde bestanden met toevoegingen van 65 en 38 verwijderingen
  1. 5 2
      rtl/inc/getopts.pp
  2. 20 16
      rtl/inc/thread.inc
  3. 14 7
      rtl/inc/threadh.inc
  4. 11 1
      rtl/objpas/typinfo.pp
  5. 15 12
      rtl/unix/cthreads.pp

+ 5 - 2
rtl/inc/getopts.pp

@@ -339,7 +339,7 @@ begin
               else
                ambig:=true;
            end;
-          inc(longint(p),sizeof(toption));
+          inc(pointer(p),sizeof(toption));
           inc(option_index);
         end;
        if ambig and not exact then
@@ -506,7 +506,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.5  2002-11-20 14:31:22  jonas
+  Revision 1.6  2004-02-22 16:48:39  florian
+    * several 64 bit issues fixed
+
+  Revision 1.5  2002/11/20 14:31:22  jonas
     * applied fix from Maxim Artemev ([email protected])
 
   Revision 1.4  2002/03/28 20:54:25  carl

+ 20 - 16
rtl/inc/thread.inc

@@ -41,18 +41,18 @@ Var
 {*****************************************************************************
                             Overloaded functions
 *****************************************************************************}
-
+{$ifndef CPU64}
     function BeginThread(sa : Pointer;stacksize : dword;
                          ThreadFunction : tthreadfunc;p : pointer;creationFlags : dword;
                          var ThreadId : Longint) : DWord;
       begin
-        BeginThread:=BeginThread(nil,StackSize,ThreadFunction,p,creationFlags,Dword(THreadId));
+        BeginThread:=BeginThread(nil,StackSize,ThreadFunction,p,creationFlags,THandle(THreadId));
       end;
-
+{$endif CPU64}
 
     function BeginThread(ThreadFunction : tthreadfunc) : DWord;
       var
-        dummy : dword;
+        dummy : THandle;
       begin
         BeginThread:=BeginThread(nil,DefaultStackSize,ThreadFunction,nil,0,dummy);
       end;
@@ -60,30 +60,31 @@ Var
 
     function BeginThread(ThreadFunction : tthreadfunc;p : pointer) : DWord;
       var
-        dummy : dword;
+        dummy : THandle;
       begin
         BeginThread:=BeginThread(nil,DefaultStackSize,ThreadFunction,p,0,dummy);
       end;
 
 
-    function BeginThread(ThreadFunction : tthreadfunc;p : pointer;var ThreadId : DWord) : DWord;
+    function BeginThread(ThreadFunction : tthreadfunc;p : pointer;var ThreadId : THandle) : DWord;
       begin
         BeginThread:=BeginThread(nil,DefaultStackSize,ThreadFunction,p,0,ThreadId);
       end;
 
 
+{$ifndef CPU64}
     function BeginThread(ThreadFunction : tthreadfunc;p : pointer;var ThreadId : Longint) : DWord;
       begin
-        BeginThread:=BeginThread(nil,DefaultStackSize,ThreadFunction,p,0,Dword(ThreadId));
+        BeginThread:=BeginThread(nil,DefaultStackSize,ThreadFunction,p,0,THandle(ThreadId));
       end;
-
+{$endif CPU64}
 
     procedure EndThread;
       begin
         EndThread(0);
       end;
 
-function BeginThread(sa : Pointer;stacksize : dword; ThreadFunction : tthreadfunc;p : pointer;creationFlags : dword;  var ThreadId : DWord) : DWord;
+function BeginThread(sa : Pointer;stacksize : dword; ThreadFunction : tthreadfunc;p : pointer;creationFlags : dword;  var ThreadId : THandle) : DWord;
 
 begin
   Result:=CurrentTM.BeginThread(sa,stacksize,threadfunction,P,creationflags,ThreadID);
@@ -187,17 +188,17 @@ begin
   If Assigned(CurrentTM.DoneManager) then
     Result:=CurrentTM.DoneManager();
   If Result then
-    begin  
-    CurrentTM:=NewTM;  
+    begin
+    CurrentTM:=NewTM;
     If Assigned(CurrentTM.InitManager) then
       Result:=CurrentTM.InitManager();
-    end;  
+    end;
 end;
 
 { ---------------------------------------------------------------------
     ThreadManager which gives run-time error. Use if no thread support.
   ---------------------------------------------------------------------}
-  
+
 
 Resourcestring
   SNoThreads = 'This binary has no thread support compiled in.';
@@ -211,12 +212,12 @@ begin
     Writeln(StdErr,SNoThreads);
     Writeln(StdErr,SRecompileWithThreads);
     end;
-  RunError(232)  
+  RunError(232)
 end;
 
 function NoBeginThread(sa : Pointer;stacksize : dword;
                      ThreadFunction : tthreadfunc;p : pointer;
-                     creationFlags : dword; var ThreadId : DWord) : DWord;
+                     creationFlags : dword; var ThreadId : THandle) : DWord;
 begin
   NoThreadError;
 end;
@@ -322,7 +323,10 @@ end;
 
 {
   $Log$
-  Revision 1.8  2004-01-21 20:11:06  peter
+  Revision 1.9  2004-02-22 16:48:39  florian
+    * several 64 bit issues fixed
+
+  Revision 1.8  2004/01/21 20:11:06  peter
     * fixed compile for unix
 
   Revision 1.7  2004/01/20 23:13:53  hajny

+ 14 - 7
rtl/inc/threadh.inc

@@ -21,14 +21,14 @@ const
 
 type
   TThreadFunc = function(parameter : pointer) : longint;
- 
+
   // Function prototypes for TThreadManager Record.
-  TBeginThreadHandler = Function (sa : Pointer;stacksize : dword; ThreadFunction : tthreadfunc;p : pointer;creationFlags : dword; var ThreadId : DWord) : DWord;
+  TBeginThreadHandler = Function (sa : Pointer;stacksize : dword; ThreadFunction : tthreadfunc;p : pointer;creationFlags : dword; var ThreadId : THandle) : DWord;
   TEndThreadHandler = Procedure (ExitCode : DWord);
   // Used for Suspend/Resume/Kill
   TThreadHandler = Function (threadHandle : dword) : dword;
   TThreadSwitchHandler = Procedure;
-  TWaitForThreadTerminateHandler = Function (threadHandle : dword; TimeoutMs : longint) : dword;  {0=no timeout} 
+  TWaitForThreadTerminateHandler = Function (threadHandle : dword; TimeoutMs : longint) : dword;  {0=no timeout}
   TThreadSetPriorityHandler = Function (threadHandle : dword; Prio: longint): boolean;            {-15..+15, 0=normal}
   TThreadGetPriorityHandler = Function (threadHandle : dword): Integer;
   TGetCurrentThreadIdHandler = Function : dword;
@@ -37,7 +37,7 @@ type
   TRelocateThreadVarHandler = Function(offset : dword) : pointer;
   TAllocateThreadVarsHandler = Procedure;
   TReleaseThreadVarsHandler = Procedure;
-  
+
   // TThreadManager interface.
   TThreadManager = Record
     InitManager            : Function : Boolean;
@@ -83,18 +83,22 @@ procedure InitThread(stklen:cardinal);
 
 function BeginThread(sa : Pointer;stacksize : dword;
   ThreadFunction : tthreadfunc;p : pointer;creationFlags : dword;
-  var ThreadId : DWord) : DWord;
+  var ThreadId : THandle) : DWord;
+{$ifndef CPU64}
 { Delphi uses a longint for threadid }
 function BeginThread(sa : Pointer;stacksize : dword;
   ThreadFunction : tthreadfunc;p : pointer;creationFlags : dword;
   var ThreadId : Longint) : DWord;
+{$endif CPU64}
 
 { add some simplfied forms which make lifer easier and porting }
 { to other OSes too ...                                        }
 function BeginThread(ThreadFunction : tthreadfunc) : DWord;
 function BeginThread(ThreadFunction : tthreadfunc;p : pointer) : DWord;
-function BeginThread(ThreadFunction : tthreadfunc;p : pointer; var ThreadId : DWord) : DWord;
+function BeginThread(ThreadFunction : tthreadfunc;p : pointer; var ThreadId : THandle) : DWord;
+{$ifndef CPU64}
 function BeginThread(ThreadFunction : tthreadfunc;p : pointer; var ThreadId : Longint) : DWord;
+{$endif CPU64}
 
 procedure EndThread(ExitCode : DWord);
 procedure EndThread;
@@ -120,7 +124,10 @@ procedure LeaveCriticalsection(var cs : TRTLCriticalSection);
 
 {
   $Log$
-  Revision 1.14  2003-11-29 17:29:32  michael
+  Revision 1.15  2004-02-22 16:48:39  florian
+    * several 64 bit issues fixed
+
+  Revision 1.14  2003/11/29 17:29:32  michael
   + Added overloaded version of SetThreadManager without old parameter
 
   Revision 1.13  2003/11/27 10:28:41  michael

+ 11 - 1
rtl/objpas/typinfo.pp

@@ -226,6 +226,7 @@ Procedure SetVariantProp(Instance: TObject; PropInfo : PPropInfo; const Value: V
 
 Function  GetObjectProp(Instance: TObject; const PropName: string): TObject;
 Function  GetObjectProp(Instance: TObject; const PropName: string; MinClass: TClass): TObject;
+Function  GetObjectProp(Instance: TObject; PropInfo: PPropInfo): TObject;
 Function  GetObjectProp(Instance: TObject; PropInfo: PPropInfo; MinClass: TClass): TObject;
 Procedure SetObjectProp(Instance: TObject; const PropName: string; Value: TObject);
 Procedure SetObjectProp(Instance: TObject; PropInfo: PPropInfo; Value: TObject);
@@ -786,6 +787,12 @@ begin
 end;
 
 
+Function GetObjectProp(Instance: TObject; PropInfo : PPropInfo): TObject;
+begin
+  Result:=GetObjectProp(Instance,PropInfo,Nil);
+end;
+
+
 Function GetObjectProp(Instance: TObject; PropInfo : PPropInfo; MinClass: TClass): TObject;
 begin
 {$ifdef cpu64}
@@ -1315,7 +1322,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.22  2004-02-21 22:53:49  florian
+  Revision 1.23  2004-02-22 16:48:39  florian
+    * several 64 bit issues fixed
+
+  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

+ 15 - 12
rtl/unix/cthreads.pp

@@ -34,11 +34,11 @@ Procedure SetCThreadManager;
 
 implementation
 
-Uses 
+Uses
   systhrds,
   BaseUnix,
   unix
-{$ifdef dynpthreads}  
+{$ifdef dynpthreads}
   ,dl
 {$endif}
   ;
@@ -166,7 +166,7 @@ Uses
 
     function CBeginThread(sa : Pointer;stacksize : dword;
                          ThreadFunction : tthreadfunc;p : pointer;
-                         creationFlags : dword; var ThreadId : DWord) : DWord;
+                         creationFlags : dword; var ThreadId : THandle) : DWord;
       var
         ti : pthreadinfo;
         thread_attr : pthread_attr_t;
@@ -196,7 +196,7 @@ Uses
 {$endif DEBUG_MT}
         pthread_attr_init(@thread_attr);
         pthread_attr_setinheritsched(@thread_attr, PTHREAD_EXPLICIT_SCHED);
-        
+
         // will fail under linux -- apparently unimplemented
         pthread_attr_setscope(@thread_attr, PTHREAD_SCOPE_PROCESS);
 
@@ -276,10 +276,10 @@ Uses
 *****************************************************************************}
 
     procedure CInitCriticalSection(var CS);
-    
+
     Var
       P : PRTLCriticalSection;
-    
+
       begin
          P:=PRTLCriticalSection(@CS);
          With p^ do
@@ -354,9 +354,9 @@ Function CInitThreads : Boolean;
 
 begin
   Writeln('Entering InitThreads.');
-{$ifndef dynpthreads} 
+{$ifndef dynpthreads}
   Result:=True;
-{$else}  
+{$else}
   Result:=LoadPthreads;
 {$endif}
   ThreadID := SizeUInt (pthread_self);
@@ -368,14 +368,14 @@ Function CDoneThreads : Boolean;
 begin
 {$ifndef dynpthreads}
   Result:=True;
-{$else}  
+{$else}
   Result:=UnloadPthreads;
 {$endif}
 end;
 
 
 Var
-  CThreadManager : TThreadManager; 
+  CThreadManager : TThreadManager;
 
 Procedure SetCThreadManager;
 
@@ -403,7 +403,7 @@ begin
     RelocateThreadVar      :=@CRelocateThreadVar;
     AllocateThreadVars     :=@CAllocateThreadVars;
     ReleaseThreadVars      :=@CReleaseThreadVars;
-{$endif}    
+{$endif}
     end;
   SetThreadManager(CThreadManager);
   InitHeapMutexes;
@@ -414,7 +414,10 @@ initialization
 end.
 {
   $Log$
-  Revision 1.8  2004-02-15 16:33:32  marco
+  Revision 1.9  2004-02-22 16:48:39  florian
+    * several 64 bit issues fixed
+
+  Revision 1.8  2004/02/15 16:33:32  marco
    * linklibs fixed for new pthread mechanism on FreeBSD
 
   Revision 1.7  2004/01/20 23:13:53  hajny