* type corrections (longing x cardinal)

rtl/emx/system.pas

@@ -5,7 +5,7 @@
     This file is part of the Free Pascal run time library.
     Copyright (c) 1999-2002 by Free Pascal development team
 
-    Free Pascal - OS/2 (EMX) runtime library
+    Free Pascal - EMX runtime library
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -39,28 +39,7 @@ interface
 {Link the startup code.}
 {$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.               *)
-    TRTLCriticalSection = 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;
+{$I systemh.inc}
 
 {$I heaph.inc}
 
@@ -78,41 +57,40 @@ type    Tos=(osDOS,osOS2,osDPMI);
 var     os_mode:Tos;
         first_meg:pointer;
 
-type    Psysthreadib=^Tsysthreadib;
-        Pthreadinfoblock=^Tthreadinfoblock;
-        PPThreadInfoBlock=^PThreadInfoBlock;
-        Pprocessinfoblock=^Tprocessinfoblock;
-        PPProcessInfoBlock=^PProcessInfoBlock;
-
-        Tbytearray=array[0..$ffff] of byte;
-        Pbytearray=^Tbytearray;
-
-        Tsysthreadib=record
-            tid,
-            priority,
-            version:longint;
-            MCcount,
-            MCforceflag:word;
-        end;
+type    TByteArray = array [0..$ffff] of byte;
+        PByteArray = ^TByteArray;
 
-        Tthreadinfoblock=record
-            pexchain,
-            stack,
-            stacklimit:pointer;
-            tib2:Psysthreadib;
-            version,
-            ordinal:longint;
+        TSysThreadIB = record
+            TID,
+            Priority,
+            Version: cardinal;
+            MCCount,
+            MCForceFlag: word;
         end;
-
-        Tprocessinfoblock=record
-            pid,
-            parentpid,
-            hmte:longint;
-            cmd,
-            env:Pbytearray;
-            flstatus,
-            ttype:longint;
+        PSysThreadIB = ^TSysThreadIB;
+
+        TThreadInfoBlock = record
+            PExChain,
+            Stack,
+            StackLimit: pointer;
+            TIB2: PSysThreadIB;
+            Version,
+            Ordinal: cardinal;
         end;
+        PThreadInfoBlock = ^TThreadInfoBlock;
+        PPThreadInfoBlock = ^PThreadInfoBlock;
+
+        TProcessInfoBlock = record
+            PID,
+            ParentPid,
+            Handle: cardinal;
+            Cmd,
+            Env: PByteArray;
+            Status,
+            ProcType: cardinal;
+        end;
+        PProcessInfoBlock = ^TProcessInfoBlock;
+        PPProcessInfoBlock = ^PProcessInfoBlock;
 
 const   UnusedHandle=$ffff;
         StdInputHandle=0;
@@ -133,7 +111,7 @@ var
 
 implementation
 
-{$I SYSTEM.INC}
+{$I system.inc}
 
 var
     heap_base: pointer; external name '__heap_base';
@@ -1006,17 +984,6 @@ begin
     end;
     exitproc:=nil;
 
-{$ifdef MT}
-    if os_mode = osOS2 then
-        begin
-            { allocate one ThreadVar entry from the OS, we use this entry }
-            { for a pointer to our threadvars                             }
-            if DosAllocThreadLocalMemory (1, DataIndex) <> 0 then RunError (8);
-            { the exceptions use threadvars so do this _before_ initexceptions }
-            AllocateThreadVars;
-        end;
-{$endif MT}
-
     {Initialize the heap.}
     initheap;
 
@@ -1042,7 +1009,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.1  2002-11-17 16:22:54  hajny
+  Revision 1.2  2002-11-17 22:32:05  hajny
+    * type corrections (longing x cardinal)
+
+  Revision 1.1  2002/11/17 16:22:54  hajny
     + RTL for emx target
 
   Revision 1.26  2002/10/27 14:29:00  hajny

rtl/emx/systhrds.pp

@@ -3,7 +3,7 @@
     This file is part of the Free Pascal run time library.
     Copyright (c) 2002 by the Free Pascal development team.
 
-    OS/2 threading support implementation
+    EMX threading support implementation
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -13,7 +13,7 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
-unit threads;
+unit systhrds;
 interface
 
 {$S-}
@@ -55,11 +55,41 @@ const
  dtStack_Commited = 2;
 
 type
- TThreadInfo = record
-  F: TThreadFunc;
-  P: pointer;
+ TByteArray = array [0..$ffff] of byte;
+ PByteArray = ^TByteArray;
+
+ TSysThreadIB = record
+  TID,
+  Priority,
+  Version: cardinal;
+  MCCount,
+  MCForceFlag: word;
  end;
- PThreadInfo = ^TThreadInfo;
+ PSysThreadIB = ^TSysThreadIB;
+
+ TThreadInfoBlock = record
+  PExChain,
+  Stack,
+  StackLimit: pointer;
+  TIB2: PSysThreadIB;
+  Version,
+  Ordinal: cardinal;
+ end;
+ PThreadInfoBlock = ^TThreadInfoBlock;
+ PPThreadInfoBlock = ^PThreadInfoBlock;
+
+ TProcessInfoBlock = record
+  PID,
+  ParentPid,
+  Handle: cardinal;
+  Cmd,
+  Env: PByteArray;
+  Status,
+  ProcType: cardinal;
+ end;
+ PProcessInfoBlock = ^TProcessInfoBlock;
+ PPProcessInfoBlock = ^PProcessInfoBlock;
+
 
 { import the necessary stuff from the OS }
 function DosAllocThreadLocalMemory (Count: cardinal; var P: pointer): longint;
@@ -101,6 +131,10 @@ function DosEnterCritSec:longint; cdecl; external 'DOSCALLS' index 232;
 
 function DosExitCritSec:longint; cdecl; external 'DOSCALLS' index 233;
 
+procedure DosGetInfoBlocks (PATIB: PPThreadInfoBlock;
+                                    PAPIB: PPProcessInfoBlock); cdecl;
+                                                 external 'DOSCALLS' index 312;
+
 
 {*****************************************************************************
                              Threadvar support
@@ -134,25 +168,14 @@ begin
  { exceptions which use threadvars but      }
  { these aren't allocated yet ...           }
  { allocate room on the heap for the thread vars }
- if os_mode = osOS2 then
- begin
-  if DosAllocMem (DataIndex^, ThreadVarBlockSize, pag_Read or pag_Write
+ if DosAllocMem (DataIndex^, ThreadVarBlockSize, pag_Read or pag_Write
                                       or pag_Commit) <> 0 then HandleError (8);
- end else
- begin
-  (* Allocate the DOS memory here. *)
-
- end;
 end;
 
 procedure SysReleaseThreadVars;
 begin
  { release thread vars }
- if os_mode = osOS2 then DosFreeMem (DataIndex^) else
- begin
-  (* Deallocate the DOS memory here. *)
-
- end;
+ DosFreeMem (DataIndex^);
 end;
 
 { Include OS independent Threadvar initialization }
@@ -160,8 +183,9 @@ end;
 
     procedure InitThreadVars;
       begin
-        { We're still running in single thread mode, setup the TLS }
-        TLSKey:=TlsAlloc;
+        { allocate one ThreadVar entry from the OS, we use this entry }
+        { for a pointer to our threadvars                             }
+        if DosAllocThreadLocalMemory (1, DataIndex) <> 0 then HandleError (8);
         { initialize threadvars }
         init_all_unit_threadvars;
         { allocate mem for main thread threadvars }
@@ -169,7 +193,7 @@ end;
         { copy main thread threadvars }
         copy_all_unit_threadvars;
         { install threadvar handler }
-        fpc_threadvar_relocate_proc:=@SysRelocateThreadvar;
+        fpc_threadvar_relocate_proc := @SysRelocateThreadvar;
       end;
 
 {$endif HASTHREADVAR}
@@ -305,32 +329,32 @@ procedure LeaveCriticalSection(var cs : TRTLCriticalSection);
     var
       HeapMutex : TRTLCriticalSection;
 
-    procedure Win32HeapMutexInit;
+    procedure OS2HeapMutexInit;
       begin
          InitCriticalSection(heapmutex);
       end;
 
-    procedure Win32HeapMutexDone;
+    procedure OS2HeapMutexDone;
       begin
          DoneCriticalSection(heapmutex);
       end;
 
-    procedure Win32HeapMutexLock;
+    procedure OS2HeapMutexLock;
       begin
          EnterCriticalSection(heapmutex);
       end;
 
-    procedure Win32HeapMutexUnlock;
+    procedure OS2HeapMutexUnlock;
       begin
          LeaveCriticalSection(heapmutex);
       end;
 
     const
-      Win32MemoryMutexManager : TMemoryMutexManager = (
-        MutexInit : @Win32HeapMutexInit;
-        MutexDone : @Win32HeapMutexDone;
-        MutexLock : @Win32HeapMutexLock;
-        MutexUnlock : @Win32HeapMutexUnlock;
+      OS2MemoryMutexManager : TMemoryMutexManager = (
+        MutexInit : @OS2HeapMutexInit;
+        MutexDone : @OS2HeapMutexDone;
+        MutexLock : @OS2HeapMutexLock;
+        MutexUnlock : @OS2HeapMutexUnlock;
       );
 
     procedure InitHeapMutexes;
@@ -346,12 +370,19 @@ procedure LeaveCriticalSection(var cs : TRTLCriticalSection);
 { Include generic overloaded routines }
 {$i thread.inc}
 
+finalization
+ DosFreeThreadLocalMemory (DataIndex);
+end;
+
 initialization
   InitHeapMutexes;
 end.
 {
   $Log$
-  Revision 1.1  2002-11-17 16:45:35  hajny
+  Revision 1.2  2002-11-17 22:32:05  hajny
+    * type corrections (longing x cardinal)
+
+  Revision 1.1  2002/11/17 16:45:35  hajny
     * threads.pp renamed to systhrds.pp
 
   Revision 1.1  2002/11/17 16:22:54  hajny

rtl/os2/system.pas

@@ -5,7 +5,7 @@
     This file is part of the Free Pascal run time library.
     Copyright (c) 1999-2002 by Free Pascal development team
 
-    Free Pascal - OS/2 (EMX) runtime library
+    Free Pascal - OS/2 runtime library
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -39,28 +39,7 @@ interface
 {Link the startup code.}
 {$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.               *)
-    TRTLCriticalSection = 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;
+{$I systemh.inc}
 
 {$I heaph.inc}
 
@@ -78,41 +57,40 @@ type    Tos=(osDOS,osOS2,osDPMI);
 var     os_mode:Tos;
         first_meg:pointer;
 
-type    Psysthreadib=^Tsysthreadib;
-        Pthreadinfoblock=^Tthreadinfoblock;
-        PPThreadInfoBlock=^PThreadInfoBlock;
-        Pprocessinfoblock=^Tprocessinfoblock;
-        PPProcessInfoBlock=^PProcessInfoBlock;
-
-        Tbytearray=array[0..$ffff] of byte;
-        Pbytearray=^Tbytearray;
-
-        Tsysthreadib=record
-            tid,
-            priority,
-            version:longint;
-            MCcount,
-            MCforceflag:word;
-        end;
+type    TByteArray = array [0..$ffff] of byte;
+        PByteArray = ^TByteArray;
 
-        Tthreadinfoblock=record
-            pexchain,
-            stack,
-            stacklimit:pointer;
-            tib2:Psysthreadib;
-            version,
-            ordinal:longint;
+        TSysThreadIB = record
+            TID,
+            Priority,
+            Version: cardinal;
+            MCCount,
+            MCForceFlag: word;
         end;
-
-        Tprocessinfoblock=record
-            pid,
-            parentpid,
-            hmte:longint;
-            cmd,
-            env:Pbytearray;
-            flstatus,
-            ttype:longint;
+        PSysThreadIB = ^TSysThreadIB;
+
+        TThreadInfoBlock = record
+            PExChain,
+            Stack,
+            StackLimit: pointer;
+            TIB2: PSysThreadIB;
+            Version,
+            Ordinal: cardinal;
         end;
+        PThreadInfoBlock = ^TThreadInfoBlock;
+        PPThreadInfoBlock = ^PThreadInfoBlock;
+
+        TProcessInfoBlock = record
+            PID,
+            ParentPid,
+            Handle: cardinal;
+            Cmd,
+            Env: PByteArray;
+            Status,
+            ProcType: cardinal;
+        end;
+        PProcessInfoBlock = ^TProcessInfoBlock;
+        PPProcessInfoBlock = ^PProcessInfoBlock;
 
 const   UnusedHandle=$ffff;
         StdInputHandle=0;
@@ -133,7 +111,7 @@ var
 
 implementation
 
-{$I SYSTEM.INC}
+{$I system.inc}
 
 var
     heap_base: pointer; external name '__heap_base';
@@ -1006,17 +984,6 @@ begin
     end;
     exitproc:=nil;
 
-{$ifdef MT}
-    if os_mode = osOS2 then
-        begin
-            { allocate one ThreadVar entry from the OS, we use this entry }
-            { for a pointer to our threadvars                             }
-            if DosAllocThreadLocalMemory (1, DataIndex) <> 0 then RunError (8);
-            { the exceptions use threadvars so do this _before_ initexceptions }
-            AllocateThreadVars;
-        end;
-{$endif MT}
-
     {Initialize the heap.}
     initheap;
 
@@ -1042,7 +1009,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.26  2002-10-27 14:29:00  hajny
+  Revision 1.27  2002-11-17 22:31:02  hajny
+    * type corrections (longing x cardinal)
+
+  Revision 1.26  2002/10/27 14:29:00  hajny
     * heap management (hopefully) fixed
 
   Revision 1.25  2002/10/14 19:39:17  peter