mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-02 10:49:33 +01:00
- excessive thread.inc removed - not required any more
This commit is contained in:
Tomas Hajny
parent
f04f3c9a58
commit
8f120ca99b
@ -1,351 +0,0 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 1999-2000 by the Free Pascal development team.
|
||||
|
||||
Multithreading implementation for OS/2
|
||||
|
||||
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
|
||||
ThreadVarBlockSize: dword = 0;
|
||||
pag_Read = 1;
|
||||
pag_Write = 2;
|
||||
pag_Execute = 4;
|
||||
pag_Guard = 8;
|
||||
pag_Commit = $10;
|
||||
obj_Tile = $40;
|
||||
sem_Indefinite_Wait = -1;
|
||||
dtSuspended = 1;
|
||||
dtStack_Commited = 2;
|
||||
|
||||
type
|
||||
TThreadInfo = record
|
||||
F: TThreadFunc;
|
||||
P: pointer;
|
||||
end;
|
||||
PThreadInfo = ^TThreadInfo;
|
||||
|
||||
var
|
||||
(* Pointer to an allocated dword space within the local thread *)
|
||||
(* memory area. Pointer to the real memory block allocated for *)
|
||||
(* thread vars in this block is then stored in this dword. *)
|
||||
DataIndex: PPointer;
|
||||
|
||||
{ import the necessary stuff from the OS }
|
||||
function DosAllocThreadLocalMemory (Count: cardinal; var P: pointer): cardinal;
|
||||
cdecl; external 'DOSCALLS' index 454;
|
||||
|
||||
function DosFreeThreadLocalMemory (P: pointer): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 455;
|
||||
|
||||
function DosCreateThread (var TID: cardinal; Address: pointer;
|
||||
(* TThreadFunc *)
|
||||
aParam: pointer; Flags: cardinal; StackSize: cardinal): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 311;
|
||||
|
||||
procedure DosExit (Action, Result: cardinal); cdecl;
|
||||
external 'DOSCALLS' index 234;
|
||||
|
||||
function DosCreateMutExSem (Name: PChar; var Handle: longint; Attr: cardinal;
|
||||
State: boolean): cardinal; cdecl; external 'DOSCALLS' index 331;
|
||||
|
||||
function DosCloseMutExSem (Handle: longint): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 333;
|
||||
|
||||
function DosQueryMutExSem (Handle: longint; var PID, TID, Count: cardinal):
|
||||
cardinal; cdecl; external 'DOSCALLS' index 336;
|
||||
|
||||
function DosRequestMutExSem (Handle: longint; Timeout: cardinal): cardinal;
|
||||
cdecl; external 'DOSCALLS' index 334;
|
||||
|
||||
function DosReleaseMutExSem (Handle: longint): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 335;
|
||||
|
||||
function DosAllocMem (var P: pointer; Size, Flag: cardinal): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 299;
|
||||
|
||||
function DosFreeMem (P: pointer): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 304;
|
||||
|
||||
function DosEnterCritSec:cardinal; cdecl; external 'DOSCALLS' index 232;
|
||||
|
||||
function DosExitCritSec:cardinal; cdecl; external 'DOSCALLS' index 233;
|
||||
|
||||
|
||||
procedure Init_ThreadVar (var TVOffset: dword; Size: dword);
|
||||
[public, alias: 'FPC_INIT_THREADVAR'];
|
||||
begin
|
||||
TVOffset := ThreadVarBlockSize;
|
||||
Inc (ThreadVarBlockSize, Size);
|
||||
end;
|
||||
|
||||
type ltvInitEntry =
|
||||
record
|
||||
varaddr : pdword;
|
||||
size : longint;
|
||||
end;
|
||||
pltvInitEntry = ^ltvInitEntry;
|
||||
|
||||
procedure init_unit_threadvars (tableEntry : pltvInitEntry);
|
||||
begin
|
||||
while tableEntry^.varaddr <> nil do
|
||||
begin
|
||||
init_threadvar (tableEntry^.varaddr^, tableEntry^.size);
|
||||
inc (pchar (tableEntry), sizeof (tableEntry^));
|
||||
end;
|
||||
end;
|
||||
|
||||
type TltvInitTablesTable =
|
||||
record
|
||||
count : dword;
|
||||
tables: array [1..32767] of pltvInitEntry;
|
||||
end;
|
||||
|
||||
var
|
||||
ThreadvarTablesTable : TltvInitTablesTable; external name 'FPC_LOCALTHREADVARTABLES';
|
||||
|
||||
procedure init_all_unit_threadvars; [public,alias: 'FPC_INITIALIZELOCALTHREADVARS'];
|
||||
var i : integer;
|
||||
begin
|
||||
{$ifdef DEBUG_MT}
|
||||
WriteLn ('init_all_unit_threadvars (%d) units',ThreadvarTablesTable.count);
|
||||
{$endif}
|
||||
for i := 1 to ThreadvarTablesTable.count do
|
||||
init_unit_threadvars (ThreadvarTablesTable.tables[i]);
|
||||
end;
|
||||
|
||||
|
||||
function Relocate_ThreadVar (TVOffset: dword): pointer;
|
||||
[public,alias: 'FPC_RELOCATE_THREADVAR'];
|
||||
begin
|
||||
Relocate_ThreadVar := DataIndex^ + TVOffset;
|
||||
end;
|
||||
|
||||
procedure AllocateThreadVars;
|
||||
begin
|
||||
{ we've to allocate the memory from the OS }
|
||||
{ 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 }
|
||||
if DosAllocMem (DataIndex^, ThreadVarBlockSize, pag_Read or pag_Write
|
||||
or pag_Commit) <> 0 then HandleError (8);
|
||||
end;
|
||||
|
||||
procedure ReleaseThreadVars;
|
||||
begin
|
||||
{ release thread vars }
|
||||
DosFreeMem (DataIndex^)
|
||||
end;
|
||||
|
||||
procedure InitThread;
|
||||
begin
|
||||
InitFPU;
|
||||
{ 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;
|
||||
var
|
||||
PTIB: PThreadInfoBlock;
|
||||
PPIB: PProcessInfoBlock;
|
||||
ThreadID: cardinal;
|
||||
begin
|
||||
ReleaseThreadVars;
|
||||
DosGetInfoBlocks (@PTIB, @PPIB);
|
||||
ThreadID := PTIB^.TIB2^.TID;
|
||||
end;
|
||||
|
||||
function ThreadMain (Param: pointer): dword; 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;
|
||||
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}
|
||||
BeginThread := DosCreateThread (ThreadID, @ThreadMain, TI, CreationFlags,
|
||||
StackSize);
|
||||
end;
|
||||
|
||||
function BeginThread (ThreadFunction: TThreadFunc): dword;
|
||||
var
|
||||
Dummy: dword;
|
||||
begin
|
||||
(* The stack size of 0 causes 4 kB to be allocated for stack. *)
|
||||
BeginThread := BeginThread (nil, 0, ThreadFunction, nil, dtStack_Commited,
|
||||
Dummy);
|
||||
end;
|
||||
|
||||
function BeginThread (ThreadFunction: TThreadFunc; P: pointer): dword;
|
||||
var
|
||||
Dummy: dword;
|
||||
begin
|
||||
(* The stack size of 0 causes 4 kB to be allocated for stack. *)
|
||||
BeginThread := BeginThread (nil, 0, ThreadFunction, P, 0, Dummy);
|
||||
end;
|
||||
|
||||
function BeginThread (ThreadFunction: TThreadFunc; P: pointer;
|
||||
var ThreadID: dword): dword;
|
||||
begin
|
||||
(* The stack size of 0 causes 4 kB to be allocated for stack. *)
|
||||
BeginThread := BeginThread (nil, 0, ThreadFunction, P, 0, ThreadID);
|
||||
end;
|
||||
|
||||
procedure EndThread (ExitCode: dword);
|
||||
begin
|
||||
DoneThread;
|
||||
DosExit (0, ExitCode);
|
||||
end;
|
||||
|
||||
procedure EndThread;
|
||||
begin
|
||||
EndThread (0);
|
||||
end;
|
||||
|
||||
procedure InitCriticalSection (var CS: TRTLCriticalSection);
|
||||
begin
|
||||
if DosCreateMutExSem (nil, CS.LockSemaphore2, 0, true) <> 0 then
|
||||
HandleError (8);
|
||||
DosEnterCritSec;
|
||||
CS.LockCount := 0;
|
||||
CS.OwningThread := $FFFF;
|
||||
DosExitCritSec;
|
||||
DosReleaseMutexSem (CS.LockSemaphore2);
|
||||
end;
|
||||
|
||||
procedure DoneCriticalSection (var CS: TRTLCriticalSection);
|
||||
begin
|
||||
DosCloseMutExSem (CS.LockSemaphore2);
|
||||
end;
|
||||
|
||||
procedure EnterCriticalSection (var CS: TRTLCriticalSection);
|
||||
var
|
||||
P, T, Cnt: cardinal;
|
||||
PTIB: PThreadInfoBlock;
|
||||
PPIB: PProcessInfoBlock;
|
||||
begin
|
||||
DosGetInfoBlocks (@PTIB, @PPIB);
|
||||
DosEnterCritSec;
|
||||
with CS do if (LockCount = 0) and
|
||||
(DosQueryMutExSem (LockSemaphore2, P, T, Cnt) = 0) and (Cnt = 0) and
|
||||
(T = PTIB^.TIB2^.TID) then
|
||||
begin
|
||||
LockCount := 1;
|
||||
OwningThread2 := PTIB^.TIB2^.TID;
|
||||
DosExitCritSec;
|
||||
DosRequestMutExSem (LockSemaphore2, sem_Indefinite_Wait);
|
||||
end else if PTIB^.TIB2^.TID = OwningThread2 then
|
||||
begin
|
||||
Inc (LockCount);
|
||||
if LockCount = 0 then Dec (LockCount);
|
||||
DosExitCritSec;
|
||||
end else
|
||||
begin
|
||||
DosExitCritSec;
|
||||
DosRequestMutExSem (LockSemaphore2, sem_Indefinite_Wait);
|
||||
DosEnterCritSec;
|
||||
LockCount := 1;
|
||||
OwningThread2 := PTIB^.TIB2^.TID;
|
||||
DosExitCritSec;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure LeaveCriticalSection (var CS: TRTLCriticalSection);
|
||||
var
|
||||
PTIB: PThreadInfoBlock;
|
||||
PPIB: PProcessInfoBlock;
|
||||
Err: boolean;
|
||||
begin
|
||||
Err := false;
|
||||
DosGetInfoBlocks (@PTIB, @PPIB);
|
||||
DosEnterCritSec;
|
||||
with CS do if OwningThread2 <> PTIB^.TIB2^.TID then
|
||||
begin
|
||||
DosExitCritSec;
|
||||
Err := true;
|
||||
end else if LockCount = 1 then
|
||||
begin
|
||||
if DosReleaseMutExSem (LockSemaphore2) <> 0 then Err := true;
|
||||
Dec (LockCount);
|
||||
DosExitCritSec;
|
||||
end else
|
||||
begin
|
||||
Dec (LockCount);
|
||||
DosExitCritSec;
|
||||
end;
|
||||
if Err then HandleError (5);
|
||||
end;
|
||||
|
||||
{$ENDIF MT}
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.14 2003-10-13 21:17:31 hajny
|
||||
* longint to cardinal corrections
|
||||
|
||||
Revision 1.13 2003/10/08 09:21:33 yuri
|
||||
* EMX code removed. Most probably, MT broken. (EMX notification removed)
|
||||
|
||||
Revision 1.12 2003/10/08 05:22:47 yuri
|
||||
* Some emx code removed
|
||||
|
||||
Revision 1.11 2003/10/07 21:26:35 hajny
|
||||
* stdcall fixes and asm routines cleanup
|
||||
|
||||
Revision 1.10 2003/02/20 17:09:49 hajny
|
||||
* fixes for OS/2 v2.1 incompatibility
|
||||
|
||||
Revision 1.9 2002/09/07 16:01:25 peter
|
||||
* old logs removed and tabs fixed
|
||||
|
||||
Revision 1.8 2002/07/07 18:04:39 hajny
|
||||
* correction by Yuri Prokushev
|
||||
|
||||
Revision 1.7 2002/03/28 16:34:29 armin
|
||||
+ initialize threadvars defined local in units
|
||||
|
||||
}
|
||||
Loading…
Reference in New Issue
Block a user