mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-02 06:29:25 +01:00
* type corrections (longing x cardinal)
This commit is contained in:
Tomas Hajny
parent
697b015e3f
commit
a70cec65e9
@ -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;
|
||||
type TByteArray = array [0..$ffff] of byte;
|
||||
PByteArray = ^TByteArray;
|
||||
|
||||
Tbytearray=array[0..$ffff] of byte;
|
||||
Pbytearray=^Tbytearray;
|
||||
|
||||
Tsysthreadib=record
|
||||
tid,
|
||||
priority,
|
||||
version:longint;
|
||||
MCcount,
|
||||
MCforceflag:word;
|
||||
TSysThreadIB = record
|
||||
TID,
|
||||
Priority,
|
||||
Version: cardinal;
|
||||
MCCount,
|
||||
MCForceFlag: word;
|
||||
end;
|
||||
PSysThreadIB = ^TSysThreadIB;
|
||||
|
||||
Tthreadinfoblock=record
|
||||
pexchain,
|
||||
stack,
|
||||
stacklimit:pointer;
|
||||
tib2:Psysthreadib;
|
||||
version,
|
||||
ordinal:longint;
|
||||
TThreadInfoBlock = record
|
||||
PExChain,
|
||||
Stack,
|
||||
StackLimit: pointer;
|
||||
TIB2: PSysThreadIB;
|
||||
Version,
|
||||
Ordinal: cardinal;
|
||||
end;
|
||||
PThreadInfoBlock = ^TThreadInfoBlock;
|
||||
PPThreadInfoBlock = ^PThreadInfoBlock;
|
||||
|
||||
Tprocessinfoblock=record
|
||||
pid,
|
||||
parentpid,
|
||||
hmte:longint;
|
||||
cmd,
|
||||
env:Pbytearray;
|
||||
flstatus,
|
||||
ttype:longint;
|
||||
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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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;
|
||||
type TByteArray = array [0..$ffff] of byte;
|
||||
PByteArray = ^TByteArray;
|
||||
|
||||
Tbytearray=array[0..$ffff] of byte;
|
||||
Pbytearray=^Tbytearray;
|
||||
|
||||
Tsysthreadib=record
|
||||
tid,
|
||||
priority,
|
||||
version:longint;
|
||||
MCcount,
|
||||
MCforceflag:word;
|
||||
TSysThreadIB = record
|
||||
TID,
|
||||
Priority,
|
||||
Version: cardinal;
|
||||
MCCount,
|
||||
MCForceFlag: word;
|
||||
end;
|
||||
PSysThreadIB = ^TSysThreadIB;
|
||||
|
||||
Tthreadinfoblock=record
|
||||
pexchain,
|
||||
stack,
|
||||
stacklimit:pointer;
|
||||
tib2:Psysthreadib;
|
||||
version,
|
||||
ordinal:longint;
|
||||
TThreadInfoBlock = record
|
||||
PExChain,
|
||||
Stack,
|
||||
StackLimit: pointer;
|
||||
TIB2: PSysThreadIB;
|
||||
Version,
|
||||
Ordinal: cardinal;
|
||||
end;
|
||||
PThreadInfoBlock = ^TThreadInfoBlock;
|
||||
PPThreadInfoBlock = ^PThreadInfoBlock;
|
||||
|
||||
Tprocessinfoblock=record
|
||||
pid,
|
||||
parentpid,
|
||||
hmte:longint;
|
||||
cmd,
|
||||
env:Pbytearray;
|
||||
flstatus,
|
||||
ttype:longint;
|
||||
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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user