From 934fe41c45899d548d426bf12a6be3c97c83dea4 Mon Sep 17 00:00:00 2001 From: florian Date: Sun, 22 Feb 2004 16:48:39 +0000 Subject: [PATCH] * several 64 bit issues fixed --- rtl/inc/getopts.pp | 7 +++++-- rtl/inc/thread.inc | 36 ++++++++++++++++++++---------------- rtl/inc/threadh.inc | 21 ++++++++++++++------- rtl/objpas/typinfo.pp | 12 +++++++++++- rtl/unix/cthreads.pp | 27 +++++++++++++++------------ 5 files changed, 65 insertions(+), 38 deletions(-) diff --git a/rtl/inc/getopts.pp b/rtl/inc/getopts.pp index ae7582e0d0..273a2f707d 100644 --- a/rtl/inc/getopts.pp +++ b/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 (bert_raccoon@freemail.ru) Revision 1.4 2002/03/28 20:54:25 carl diff --git a/rtl/inc/thread.inc b/rtl/inc/thread.inc index 9b81d131a8..8a862fc3f6 100644 --- a/rtl/inc/thread.inc +++ b/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 diff --git a/rtl/inc/threadh.inc b/rtl/inc/threadh.inc index c11e6f718b..94ce4a343e 100644 --- a/rtl/inc/threadh.inc +++ b/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 diff --git a/rtl/objpas/typinfo.pp b/rtl/objpas/typinfo.pp index a6e6844955..39e3ec1b09 100644 --- a/rtl/objpas/typinfo.pp +++ b/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 diff --git a/rtl/unix/cthreads.pp b/rtl/unix/cthreads.pp index fd145befa1..8dbb603c96 100644 --- a/rtl/unix/cthreads.pp +++ b/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