- excessive thread.inc removed - not required any more

rtl/os2/thread.inc

@@ -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
-
-}