paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-17 01:59:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

* several 64 bit issues fixed

Browse Source
This commit is contained in:
florian 2004-02-22 16:48:39 +00:00
parent 0c35b6f3c4
commit 934fe41c45
5 changed files with 65 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
rtl/inc/getopts.pp
View File

@ -339,7 +339,7 @@ begin
else else
ambig:=true; ambig:=true;
end; end;
inc(longint(p),sizeof(toption)); inc(pointer(p),sizeof(toption));
inc(option_index); inc(option_index);
end; end;
if ambig and not exact then if ambig and not exact then
@ -506,7 +506,10 @@ begin
end. end.
{ {
$Log$ $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) * applied fix from Maxim Artemev (bert_raccoon@freemail.ru)
Revision 1.4 2002/03/28 20:54:25 carl Revision 1.4 2002/03/28 20:54:25 carl

36
rtl/inc/thread.inc
View File

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

21
rtl/inc/threadh.inc
View File

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

12
rtl/objpas/typinfo.pp
View File

@ -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): TObject;
Function GetObjectProp(Instance: TObject; const PropName: string; MinClass: TClass): 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; Function GetObjectProp(Instance: TObject; PropInfo: PPropInfo; MinClass: TClass): TObject;
Procedure SetObjectProp(Instance: TObject; const PropName: string; Value: TObject); Procedure SetObjectProp(Instance: TObject; const PropName: string; Value: TObject);
Procedure SetObjectProp(Instance: TObject; PropInfo: PPropInfo; Value: TObject); Procedure SetObjectProp(Instance: TObject; PropInfo: PPropInfo; Value: TObject);
@ -786,6 +787,12 @@ begin
end; end;
Function GetObjectProp(Instance: TObject; PropInfo : PPropInfo): TObject;
begin
Result:=GetObjectProp(Instance,PropInfo,Nil);
end;
Function GetObjectProp(Instance: TObject; PropInfo : PPropInfo; MinClass: TClass): TObject; Function GetObjectProp(Instance: TObject; PropInfo : PPropInfo; MinClass: TClass): TObject;
begin begin
{$ifdef cpu64} {$ifdef cpu64}
@ -1315,7 +1322,10 @@ end;
end. end.
{ {
$Log$ $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 * several 64 bit/x86-64 fixes
Revision 1.21 2004/02/20 15:55:26 peter Revision 1.21 2004/02/20 15:55:26 peter

27
rtl/unix/cthreads.pp
View File

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