|
@@ -1,189 +0,0 @@
|
|
-{
|
|
|
|
- $Id$
|
|
|
|
- This file is part of the Free Pascal run time library.
|
|
|
|
- Copyright (c) 2001 by the Free Pascal development team.
|
|
|
|
-
|
|
|
|
- Multithreading implementation for Linux
|
|
|
|
-
|
|
|
|
- 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.
|
|
|
|
-
|
|
|
|
- **********************************************************************}
|
|
|
|
-{$ifdef MT}
|
|
|
|
-
|
|
|
|
- const
|
|
|
|
- DefaultStackSize = 16384;
|
|
|
|
- threadvarblocksize : dword = 0;
|
|
|
|
-
|
|
|
|
- type
|
|
|
|
- pthreadinfo = ^tthreadinfo;
|
|
|
|
- tthreadinfo = record
|
|
|
|
- f : tthreadfunc;
|
|
|
|
- p : pointer;
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
- var
|
|
|
|
- dataindex : pointer;
|
|
|
|
-
|
|
|
|
- procedure init_threadvar(var offset : dword;size : dword);[public,alias: 'FPC_INIT_THREADVAR'];
|
|
|
|
- begin
|
|
|
|
- offset:=threadvarblocksize;
|
|
|
|
- inc(threadvarblocksize,size);
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
-
|
|
|
|
- function relocate_threadvar(offset : dword) : pointer;[public,alias: 'FPC_RELOCATE_THREADVAR'];
|
|
|
|
- begin
|
|
|
|
- Relocate_ThreadVar := DataIndex + Offset;
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
-
|
|
|
|
- procedure AllocateThreadVars;
|
|
|
|
- begin
|
|
|
|
- { we've to allocate the memory from system }
|
|
|
|
- { because the FPC heap management uses }
|
|
|
|
- { exceptions which use threadvars but }
|
|
|
|
- { these aren't allocated yet ... }
|
|
|
|
- { allocate room on the heap for the thread vars }
|
|
|
|
- DataIndex:=Pointer(Sys_mmap(0,threadvarblocksize,3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0));
|
|
|
|
- FillChar(DataIndex^,threadvarblocksize,0);
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
-
|
|
|
|
- procedure ReleaseThreadVars;
|
|
|
|
- begin
|
|
|
|
- Sys_munmap(Longint(dataindex),threadvarblocksize);
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
-
|
|
|
|
- procedure InitThread;
|
|
|
|
- begin
|
|
|
|
- ResetFPU;
|
|
|
|
- { we don't need to set the data to 0 because we did this with }
|
|
|
|
- { the fillchar above, but it looks nicer }
|
|
|
|
-
|
|
|
|
- { ExceptAddrStack and ExceptObjectStack are threadvars }
|
|
|
|
- { so every thread has its on exception handling capabilities }
|
|
|
|
- InitExceptions;
|
|
|
|
- InOutRes:=0;
|
|
|
|
- // ErrNo:=0;
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
-
|
|
|
|
- procedure DoneThread;
|
|
|
|
- begin
|
|
|
|
- { release thread vars }
|
|
|
|
- ReleaseThreadVars;
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
-
|
|
|
|
- function ThreadMain(param : pointer) : longint;cdecl;
|
|
|
|
- var
|
|
|
|
- ti : tthreadinfo;
|
|
|
|
- begin
|
|
|
|
-{$ifdef DEBUG_MT}
|
|
|
|
- writeln('New thread started, initialising ...');
|
|
|
|
-{$endif DEBUG_MT}
|
|
|
|
- AllocateThreadVars;
|
|
|
|
- InitThread;
|
|
|
|
- ti:=pthreadinfo(param)^;
|
|
|
|
- dispose(pthreadinfo(param));
|
|
|
|
-{$ifdef DEBUG_MT}
|
|
|
|
- writeln('Jumping to thread function');
|
|
|
|
-{$endif DEBUG_MT}
|
|
|
|
- ThreadMain:=ti.f(ti.p);
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
-
|
|
|
|
- function BeginThread(sa : Pointer;stacksize : dword;
|
|
|
|
- ThreadFunction : tthreadfunc;p : pointer;
|
|
|
|
- creationFlags : dword; var ThreadId : DWord) : DWord;
|
|
|
|
- var
|
|
|
|
- ti : pthreadinfo;
|
|
|
|
- FStackPointer : pointer;
|
|
|
|
- Flags : longint;
|
|
|
|
- begin
|
|
|
|
-{$ifdef DEBUG_MT}
|
|
|
|
- writeln('Creating new thread');
|
|
|
|
-{$endif DEBUG_MT}
|
|
|
|
- IsMultithread:=true;
|
|
|
|
- { the only way to pass data to the newly created thread }
|
|
|
|
- { in a MT safe way, is to use the heap }
|
|
|
|
- new(ti);
|
|
|
|
- ti^.f:=ThreadFunction;
|
|
|
|
- ti^.p:=p;
|
|
|
|
-{$ifdef DEBUG_MT}
|
|
|
|
- writeln('Starting new thread');
|
|
|
|
-{$endif DEBUG_MT}
|
|
|
|
- Flags := CLONE_VM + CLONE_FS + CLONE_FILES + CLONE_SIGHAND + SIGCHLD;
|
|
|
|
- { Setup stack }
|
|
|
|
- Getmem(pointer(FStackPointer),StackSize);
|
|
|
|
- inc(FStackPointer,StackSize);
|
|
|
|
- { Clone }
|
|
|
|
- ThreadID:=Clone(@ThreadMain,pointer(FStackPointer),Flags,ti);
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
-
|
|
|
|
- function BeginThread(ThreadFunction : tthreadfunc) : DWord;
|
|
|
|
- var
|
|
|
|
- dummy : dword;
|
|
|
|
- begin
|
|
|
|
- BeginThread:=BeginThread(nil,DefaultStackSize,ThreadFunction,nil,0,dummy);
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
-
|
|
|
|
- function BeginThread(ThreadFunction : tthreadfunc;p : pointer) : DWord;
|
|
|
|
- var
|
|
|
|
- dummy : dword;
|
|
|
|
- begin
|
|
|
|
- BeginThread:=BeginThread(nil,DefaultStackSize,ThreadFunction,p,0,dummy);
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
-
|
|
|
|
- function BeginThread(ThreadFunction : tthreadfunc;p : pointer;var ThreadId : DWord) : DWord;
|
|
|
|
- begin
|
|
|
|
- BeginThread:=BeginThread(nil,DefaultStackSize,ThreadFunction,p,0,ThreadId);
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
-
|
|
|
|
- procedure EndThread(ExitCode : DWord);
|
|
|
|
- begin
|
|
|
|
- DoneThread;
|
|
|
|
- Sys_Exit(ExitCode);
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
-
|
|
|
|
- procedure EndThread;
|
|
|
|
- begin
|
|
|
|
- EndThread(0);
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
- procedure InitCriticalSection(var cs : tcriticalsection);
|
|
|
|
- begin
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
- procedure DoneCriticalSection(var cs : tcriticalsection);
|
|
|
|
- begin
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
-
|
|
|
|
- procedure EnterCriticalSection(var cs : tcriticalsection);
|
|
|
|
- begin
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
- procedure LeaveCriticalSection(var cs : tcriticalsection);
|
|
|
|
- begin
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
-{$endif MT}
|
|
|
|
-
|
|
|
|
-{
|
|
|
|
- $Log$
|
|
|
|
- Revision 1.1 2001-10-14 13:33:20 peter
|
|
|
|
- * start of thread support for linux
|
|
|
|
-
|
|
|
|
-}
|
|
|