+ beginning of the OS/2 version

rtl/os2/system.pas

@@ -877,6 +877,17 @@ begin
     end;
     exitproc:=nil;
 
+{$ifdef MT}
+    if os_mode = os_OS2 then
+        begin
+            { allocate one ThreadVar entry from the OS, we use this entry }
+            { for a pointer to our threadvars                             }
+            DataIndex := TlsAlloc;
+            { the exceptions use threadvars so do this _before_ initexceptions }
+            AllocateThreadVars;
+        end;
+{$endif MT}
+
     {Initialize the heap.}
     initheap;
 
@@ -896,7 +907,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.4  2000-11-13 21:23:38  hajny
+  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
     * ParamStr (0) fixed
 
   Revision 1.3  2000/11/11 23:12:39  hajny

rtl/os2/thread.inc

@@ -0,0 +1,183 @@
+{
+    $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.
+
+ **********************************************************************}
+const
+ ThreadVarBlockSize: dword = 0;
+
+type
+ TThreadInfo = record
+  F: TThreadFunc;
+  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;
+
+{ import the necessary stuff from the OS }
+function DosAllocThreadLocalMemory (Count: cardinal; var P: pointer): longint;
+                                          cdecl; external 'DOSCALLS' index 454;
+
+function DosFreeThreadLocalMemory (P: pointer): longint; cdecl;
+                                                 external 'DOSCALLS' index 455;
+
+function DosCreateThread (var TID: longint; Address: TThreadEntry;
+        aParam: pointer; Flags: longint; StackSize: longint): longint; cdecl;
+                                                 external 'DOSCALLS' index 311;
+
+procedure DosExit (Action, Result: longint); 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;
+
+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, ) <> 0 then RunError (8);
+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;
+begin
+ { release thread vars }
+ DosFreeMem (DataIndex^);
+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}
+ IsMultiThreaded := 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 := CreateThread (sa,stacksize,@ThreadMain,ti,
+       creationflags,threadid);
+end;
+
+function BeginThread (ThreadFunction: TThreadFunc): dword;
+var
+ Dummy: dword;
+begin
+ BeginThread := BeginThread (nil, 0, ThreadFunction, nil, 0, Dummy);
+end;
+
+function BeginThread (ThreadFunction: TThreadFunc; P: pointer): dword;
+var
+ Dummy: dword;
+begin
+ BeginThread := BeginThread (nil, 0, ThreadFunction, P, 0, Dummy);
+end;
+
+function BeginThread (ThreadFunction: TThreadFunc; P: pointer;
+                                                   var ThreadID: dword): dword;
+begin
+ 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 : tcriticalsection);
+begin
+end;
+
+procedure DoneCriticalsection(var cs : tcriticalsection);
+begin
+end;
+
+procedure EnterCriticalsection(var cs : tcriticalsection);
+begin
+end;
+
+procedure LeaveCriticalsection(var cs : tcriticalsection);
+begin
+end;
+
+{
+  $Log$
+  Revision 1.1  2001-01-23 20:38:59  hajny
+    + beginning of the OS/2 version
+
+  Revision 1.1  2001/01/01 19:06:36  florian
+    + initial release
+
+}