* OS/2 implementation of threads almost finished

rtl/os2/thread.inc

@@ -13,8 +13,20 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+
+{$DEFINE EMX}
+
 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
@@ -29,6 +41,7 @@ var
 (* 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;
@@ -44,6 +57,25 @@ function DosCreateThread (var TID: longint; Address: TThreadEntry;
 procedure DosExit (Action, Result: longint); cdecl;
                                                  external 'DOSCALLS' index 233;
 
+function DosCreateMutExSem (Name: PChar; var Handle: longint; Attr: longint;
+                State: boolean): longint; cdecl; external 'DOSCALLS' index 331;
+
+function DosCloseMutExSem (Handle: longint): longint; cdecl;
+                                                 external 'DOSCALLS' index 333;
+
+function DosRequestMutExSem (Handle, Timeout: longint): longint; cdecl;
+                                                 external 'DOSCALLS' index 334;
+
+function DosReleaseMutExSem (Handle: longint): longint; cdecl;
+                                                 external 'DOSCALLS' index 335;
+
+function DosAllocMem (var P: pointer; Size, Flag: longint): longint; cdecl;
+                                                 external 'DOSCALLS' index 299;
+
+function DosFreeMem (P: pointer): longint; cdecl;
+                                                 external 'DOSCALLS' index 304;
+
+
 procedure Init_ThreadVar (var TVOffset: dword; Size: dword);
                                          [public, alias: 'FPC_INIT_THREADVAR'];
 begin
@@ -64,7 +96,15 @@ begin
  { 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);
+ if os_mode = osOS2 then
+ begin
+  if DosAllocMem (DataIndex^, ThreadVarBlockSize, pag_Read or pag_Write
+                                         or pag_Commit) <> 0 then RunError (8);
+ end else
+ begin
+  (* Allocate the DOS memory here. *)
+
+ end;
 end;
 
 procedure InitThread;
@@ -83,7 +123,23 @@ end;
 procedure DoneThread;
 begin
  { release thread vars }
- DosFreeMem (DataIndex^);
+ if os_mode = osOS2 then
+ begin
+  DosFreeMem (DataIndex^);
+{$IFDEF EMX}
+{$ASMMODE INTEL}
+  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
@@ -121,27 +177,40 @@ begin
 {$ifdef DEBUG_MT}
  WriteLn ('Starting new thread');
 {$endif DEBUG_MT}
- BeginThread := CreateThread (sa,stacksize,@ThreadMain,ti,
-       creationflags,threadid);
+ BeginThread := DosCreateThread (ThreadID, @ThreadMain, TI, StackSize, TI,
+       CreationFlags);
+{$IFDEF EMX}
+{$ASMMODE INTEL}
+ asm
+  mov eax, 7F2Ch
+  mov edx, ThreadID
+  call syscall
+ end;
+{$ASMMODE DEFAULT}
+{$ENDIF EMX}
 end;
 
 function BeginThread (ThreadFunction: TThreadFunc): dword;
 var
  Dummy: dword;
 begin
- BeginThread := BeginThread (nil, 0, ThreadFunction, nil, 0, Dummy);
+(* 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;
 
@@ -156,25 +225,33 @@ begin
  EndThread (0);
 end;
 
-procedure InitCriticalSection (var cs : tcriticalsection);
+procedure InitCriticalSection (var CS);
 begin
+ if os_mode = osOS2 then
+      if DosCreateMutExSem (nil, CritSectSem, 0, false) <> 0 then RunError (8);
 end;
 
-procedure DoneCriticalsection(var cs : tcriticalsection);
+procedure DoneCriticalSection (var CS);
 begin
+ if os_mode = osOS2 then DosCloseMutExSem (CritSectSem);
 end;
 
-procedure EnterCriticalsection(var cs : tcriticalsection);
+procedure EnterCriticalsection (var CS);
 begin
+ if os_mode = osOS2 then DosRequestMutExSem (CritSectSem, sem_Indefinite_Wait);
 end;
 
-procedure LeaveCriticalsection(var cs : tcriticalsection);
+procedure LeaveCriticalsection(var cs);
 begin
+ if os_mode = osOS2 then DosReleaseMutExSem (CritSectSem);
 end;
 
 {
   $Log$
-  Revision 1.1  2001-01-23 20:38:59  hajny
+  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
     + beginning of the OS/2 version
 
   Revision 1.1  2001/01/01 19:06:36  florian