paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-03 10:30:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

* MT support completion

Browse Source
This commit is contained in:
Tomas Hajny 2001-02-01 21:30:01 +00:00
parent 25a41ffa44
commit ce36dc07ec
2 changed files with 169 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

70
rtl/os2/system.pas
View File

@ -46,7 +46,7 @@ Coding style:
My coding style is a bit unusual for Pascal. Nevertheless I friendly ask
you to try to make your changes not look all to different. In general,
set your IDE to use tab characters, optimal fill on and a tabsize of 4.}
set your IDE to use a tabsize of 4.}
interface
@ -54,6 +54,31 @@ interface
{$l prt1.oo2}
{$I SYSTEMH.INC}
type
{ FK: The fields of this record are OS dependent and they shouldn't }
{ be used in a program; only the type TCriticalSection is important. }
(* TH: To make things easier, I copied the record definition *)
(* from the Win32 version and just added longint variants, *)
(* because it seemed well suited for OS/2 too. *)
TCriticalSection = packed record
DebugInfo: pointer;
LockCount: longint;
RecursionCount: longint;
case boolean of
false:
(OwningThread: DWord;
LockSemaphore: DWord;
Reserved: DWord);
true:
(OwningThread2: longint;
LockSemaphore2: longint;
Reserved2: longint);
end;
{ include threading stuff }
{$i threadh.inc}
{$I heaph.inc}
type Tos=(osDOS,osOS2,osDPMI);
@ -61,9 +86,11 @@ type Tos=(osDOS,osOS2,osDPMI);
var os_mode:Tos;
first_meg:pointer;
type Psysthreadib=^Tsysthreadib;
Pthreadinfoblock=^Tthreadinfoblock;
Pprocessinfoblock=^Tprocessinfoblock;
type PSysThreadIB=^TSysThreadIB;
PThreadInfoBlock=^Tthreadinfoblock;
PPThreadInfoBlock=^PThreadInfoBlock;
PProcessInfoBlock=^TProcessInfoBlock;
PPProcessInfoBlock=^PProcessInfoBlock;
Tbytearray=array[0..$ffff] of byte;
Pbytearray=^Tbytearray;
@ -113,8 +140,8 @@ implementation
{$I SYSTEM.INC}
procedure DosGetInfoBlocks (var Atib: PThreadInfoBlock;
var Apib: PProcessInfoBlock); cdecl;
procedure DosGetInfoBlocks (PATIB: PPThreadInfoBlock;
PAPIB: PPProcessInfoBlock); cdecl;
external 'DOSCALLS' index 312;
function DosSetRelMaxFH (var ReqCount, CurMaxFH: longint): longint; cdecl;
@ -800,6 +827,23 @@ end;
{****************************************************************************
Thread Handling
*****************************************************************************}
const
fpucw: word = $1332;
procedure InitFPU; assembler;
asm
fninit
fldcw fpucw
end;
{ include threading stuff, this is os independend part }
{$I thread.inc}
{*****************************************************************************
System unit initialization.
****************************************************************************}
@ -812,8 +856,7 @@ begin
else GetFileHandleCount := L2;
end;
var pib:Pprocessinfoblock;
tib:Pthreadinfoblock;
var tib:Pthreadinfoblock;
begin
{Determine the operating system we are running on.}
@ -868,7 +911,7 @@ begin
stack bottom.}
osOS2:
begin
dosgetinfoblocks(tib,pib);
dosgetinfoblocks(@tib,nil);
stackbottom:=longint(tib^.stack);
end;
osDPMI:
@ -878,11 +921,11 @@ begin
exitproc:=nil;
{$ifdef MT}
if os_mode = os_OS2 then
if os_mode = osOS2 then
begin
{ allocate one ThreadVar entry from the OS, we use this entry }
{ for a pointer to our threadvars }
DataIndex := TlsAlloc;
if DosAllocThreadLocalMemory (1, DataIndex) <> 0 then RunError (8);
{ the exceptions use threadvars so do this _before_ initexceptions }
AllocateThreadVars;
end;
@ -907,7 +950,10 @@ begin
end.
{
$Log$
Revision 1.5 2001-01-23 20:38:59 hajny
Revision 1.6 2001-02-01 21:30:01 hajny
* MT support completion
Revision 1.5 2001/01/23 20:38:59 hajny
+ beginning of the OS/2 version
Revision 1.4 2000/11/13 21:23:38 hajny

142
rtl/os2/thread.inc
View File

@ -14,6 +14,7 @@
**********************************************************************}
{$IFDEF MT}
{$DEFINE EMX}
const
@ -34,14 +35,12 @@ type
P: pointer;
end;
PThreadInfo = ^TThreadInfo;
PPointer = ^pointer;
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;
CritSectSem: longint;
{ import the necessary stuff from the OS }
function DosAllocThreadLocalMemory (Count: cardinal; var P: pointer): longint;
@ -50,7 +49,8 @@ function DosAllocThreadLocalMemory (Count: cardinal; var P: pointer): longint;
function DosFreeThreadLocalMemory (P: pointer): longint; cdecl;
external 'DOSCALLS' index 455;
function DosCreateThread (var TID: longint; Address: TThreadEntry;
function DosCreateThread (var TID: longint; Address: pointer;
(* TThreadFunc *)
aParam: pointer; Flags: longint; StackSize: longint): longint; cdecl;
external 'DOSCALLS' index 311;
@ -63,6 +63,9 @@ function DosCreateMutExSem (Name: PChar; var Handle: longint; Attr: longint;
function DosCloseMutExSem (Handle: longint): longint; cdecl;
external 'DOSCALLS' index 333;
function DosQueryMutExSem (Handle: longint; var PID, TID, Count: longint):
longint; cdecl; external 'DOSCALLS' index 336;
function DosRequestMutExSem (Handle, Timeout: longint): longint; cdecl;
external 'DOSCALLS' index 334;
@ -75,6 +78,10 @@ function DosAllocMem (var P: pointer; Size, Flag: longint): longint; cdecl;
function DosFreeMem (P: pointer): longint; cdecl;
external 'DOSCALLS' index 304;
function DosEnterCritSec:longint; cdecl; external 'DOSCALLS' index 232;
function DosExitCritSec:longint; cdecl; external 'DOSCALLS' index 233;
procedure Init_ThreadVar (var TVOffset: dword; Size: dword);
[public, alias: 'FPC_INIT_THREADVAR'];
@ -86,7 +93,7 @@ end;
function Relocate_ThreadVar (TVOffset: dword): pointer;
[public,alias: 'FPC_RELOCATE_THREADVAR'];
begin
Relocate_ThreadVar := DataIndex + TVOffset;
Relocate_ThreadVar := DataIndex^ + TVOffset;
end;
procedure AllocateThreadVars;
@ -107,6 +114,16 @@ begin
end;
end;
procedure ReleaseThreadVars;
begin
{ release thread vars }
if os_mode = osOS2 then DosFreeMem (DataIndex^) else
begin
(* Deallocate the DOS memory here. *)
end;
end;
procedure InitThread;
begin
InitFPU;
@ -117,32 +134,30 @@ begin
{ so every thread has its on exception handling capabilities }
InitExceptions;
InOutRes := 0;
ErrNo := 0;
{ ErrNo := 0;}
end;
procedure DoneThread;
var
PTIB: PThreadInfoBlock;
ThreadID: longint;
begin
{ release thread vars }
if os_mode = osOS2 then
begin
DosFreeMem (DataIndex^);
ReleaseThreadVars;
DosGetInfoBlocks (@PTIB, nil);
ThreadID := PTIB^.TIB2^.TID;
{$IFDEF EMX}
{$ASMMODE INTEL}
asm
mov eax, 7F2Dh
mov edx, ThreadID
call syscall
end;
if os_mode = osOS2 then
asm
mov eax, 7F2Dh
mov edx, ThreadID
call syscall
end;
{$ASMMODE DEFAULT}
{$ENDIF EMX}
end else
begin
(* Deallocate the DOS memory here. *)
end;
end;
function ThreadMain (Param: pointer): dword; cdecl
function ThreadMain (Param: pointer): dword; cdecl;
var
TI: TThreadInfo;
begin
@ -177,8 +192,8 @@ begin
{$ifdef DEBUG_MT}
WriteLn ('Starting new thread');
{$endif DEBUG_MT}
BeginThread := DosCreateThread (ThreadID, @ThreadMain, TI, StackSize, TI,
CreationFlags);
BeginThread := DosCreateThread (ThreadID, @ThreadMain, TI, CreationFlags,
StackSize);
{$IFDEF EMX}
{$ASMMODE INTEL}
asm
@ -225,30 +240,95 @@ begin
EndThread (0);
end;
procedure InitCriticalSection (var CS);
procedure InitCriticalSection (var CS: TCriticalSection);
begin
if os_mode = osOS2 then
if DosCreateMutExSem (nil, CritSectSem, 0, false) <> 0 then RunError (8);
begin
if DosCreateMutExSem (nil, CS.LockSemaphore2, 0, true) <> 0 then
RunError (8);
DosEnterCritSec;
CS.LockCount := 0;
CS.OwningThread := $FFFF;
DosExitCritSec;
DosReleaseMutexSem (CS.LockSemaphore2);
end;
end;
procedure DoneCriticalSection (var CS);
procedure DoneCriticalSection (var CS: TCriticalSection);
begin
if os_mode = osOS2 then DosCloseMutExSem (CritSectSem);
if os_mode = osOS2 then DosCloseMutExSem (CS.LockSemaphore2);
end;
procedure EnterCriticalsection (var CS);
procedure EnterCriticalSection (var CS: TCriticalSection);
var
P, T, Cnt: longint;
PTIB: PThreadInfoBlock;
begin
if os_mode = osOS2 then DosRequestMutExSem (CritSectSem, sem_Indefinite_Wait);
if os_mode = osOS2 then
begin
DosGetInfoBlocks (@PTIB, nil);
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;
end;
procedure LeaveCriticalsection(var cs);
procedure LeaveCriticalSection (var CS: TCriticalSection);
var
PTIB: PThreadInfoBlock;
Err: boolean;
begin
if os_mode = osOS2 then DosReleaseMutExSem (CritSectSem);
if os_mode = osOS2 then
begin
Err := false;
DosGetInfoBlocks (@PTIB, nil);
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 RunError (5);
end;
end;
{$ENDIF MT}
{
$Log$
Revision 1.2 2001-01-27 18:28:52 hajny
Revision 1.3 2001-02-01 21:30:01 hajny
* MT support completion
Revision 1.2 2001/01/27 18:28:52 hajny
* OS/2 implementation of threads almost finished
Revision 1.1 2001/01/23 20:38:59 hajny