mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-19 05:00:12 +02:00
* fixes for OS/2 v2.1 incompatibility
This commit is contained in:
Tomas Hajny
parent
8520cddfe6
commit
703367dd40
@ -111,9 +111,10 @@ end;
|
||||
function TThread.GetPriority: TThreadPriority;
|
||||
var
|
||||
PTIB: PThreadInfoBlock;
|
||||
PPIB: PProcessInfoBlock;
|
||||
I: TThreadPriority;
|
||||
begin
|
||||
DosGetInfoBlocks (@PTIB, nil);
|
||||
DosGetInfoBlocks (@PTIB, @PPIB);
|
||||
with PTIB^.TIB2^ do
|
||||
if Priority >= $300 then GetPriority := tpTimeCritical else
|
||||
if Priority < $200 then GetPriority := tpIdle else
|
||||
@ -129,8 +130,9 @@ end;
|
||||
procedure TThread.SetPriority(Value: TThreadPriority);
|
||||
var
|
||||
PTIB: PThreadInfoBlock;
|
||||
PPIB: PProcessInfoBlock;
|
||||
begin
|
||||
DosGetInfoBlocks (@PTIB, nil);
|
||||
DosGetInfoBlocks (@PTIB, @PPIB);
|
||||
(*
|
||||
PTIB^.TIB2^.Priority := Priorities [Value];
|
||||
*)
|
||||
@ -231,7 +233,10 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.6 2002-09-07 15:15:27 peter
|
||||
Revision 1.7 2003-02-20 17:12:39 hajny
|
||||
* fixes for OS/2 v2.1 incompatibility
|
||||
|
||||
Revision 1.6 2002/09/07 15:15:27 peter
|
||||
* old logs removed and tabs fixed
|
||||
|
||||
Revision 1.5 2002/02/10 13:38:14 hajny
|
||||
|
||||
@ -1161,7 +1161,8 @@ var
|
||||
ptr : pchar;
|
||||
base : pchar;
|
||||
i: integer;
|
||||
tib : pprocessinfoblock;
|
||||
PIB: PProcessInfoBlock;
|
||||
TIB: PThreadInfoBlock;
|
||||
begin
|
||||
{ We need to setup the environment }
|
||||
{ only in the case of OS/2 }
|
||||
@ -1170,8 +1171,8 @@ begin
|
||||
exit;
|
||||
cnt := 0;
|
||||
{ count number of environment pointers }
|
||||
dosgetinfoblocks (nil, PPProcessInfoBlock (@tib));
|
||||
ptr := pchar(tib^.env);
|
||||
DosGetInfoBlocks (PPThreadInfoBlocks (@TIB), PPProcessInfoBlock (@PIB));
|
||||
ptr := pchar(PIB^.env);
|
||||
{ stringz,stringz...,#0 }
|
||||
i := 0;
|
||||
repeat
|
||||
@ -1188,7 +1189,7 @@ begin
|
||||
{ got count of environment strings }
|
||||
GetMem(envp, cnt*sizeof(pchar)+16384);
|
||||
cnt := 0;
|
||||
ptr := pchar(tib^.env);
|
||||
ptr := pchar(PIB^.env);
|
||||
i:=0;
|
||||
repeat
|
||||
envp[cnt] := ptr;
|
||||
@ -1221,7 +1222,10 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.23 2003-01-04 15:43:50 hajny
|
||||
Revision 1.24 2003-02-20 17:09:49 hajny
|
||||
* fixes for OS/2 v2.1 incompatibility
|
||||
|
||||
Revision 1.23 2003/01/04 15:43:50 hajny
|
||||
+ GetEnvPChar added
|
||||
|
||||
Revision 1.22 2002/12/07 19:46:56 hajny
|
||||
|
||||
@ -165,12 +165,13 @@ type PThreadInfoBlock=^TThreadInfoBlock;
|
||||
ProcessInfoBlock=TProcessInfoBlock;
|
||||
|
||||
{OS/2 keeps information about the current process and the current thread
|
||||
is the datastructures Tprocessinfoblock and Tthreadinfoblock. All data
|
||||
is the datastructures TProcessInfoBlock and TThreadInfoBlock. All data
|
||||
can both be read and be changed. Use DosGetInfoBlocks to get their
|
||||
address. The service cannot fail, so it is defined as procedure.
|
||||
The second version of the call might be useful if you only want address
|
||||
of one of those datastructures, since you can supply nil for the other
|
||||
parameter then.}
|
||||
address. The service cannot fail, so it is defined as procedure. The
|
||||
second version of the call might be useful if you only want address of one
|
||||
of those datastructures, since you can supply nil for the other parameter
|
||||
then - beware, omitting one of these parameters (passing nil) is only
|
||||
supported on newer OS/2 versions, and causes SIGSEGV on e.g. OS/2 v2.1!!!}
|
||||
|
||||
procedure DosGetInfoBlocks(var ATIB:PThreadInfoBlock;
|
||||
var APIB:PProcessInfoBlock); cdecl;
|
||||
@ -4534,7 +4535,10 @@ external 'DOSCALLS' index 582;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.19 2003-01-05 16:37:22 hajny
|
||||
Revision 1.20 2003-02-20 17:09:49 hajny
|
||||
* fixes for OS/2 v2.1 incompatibility
|
||||
|
||||
Revision 1.19 2003/01/05 16:37:22 hajny
|
||||
* DosCalls not using Objects any more
|
||||
|
||||
Revision 1.18 2002/11/14 21:16:22 hajny
|
||||
|
||||
@ -176,10 +176,11 @@ end;
|
||||
procedure DoneThread;
|
||||
var
|
||||
PTIB: PThreadInfoBlock;
|
||||
PPIB: PProcessInfoBlock;
|
||||
ThreadID: longint;
|
||||
begin
|
||||
ReleaseThreadVars;
|
||||
DosGetInfoBlocks (@PTIB, nil);
|
||||
DosGetInfoBlocks (@PTIB, @PPIB);
|
||||
ThreadID := PTIB^.TIB2^.TID;
|
||||
{$IFDEF EMX}
|
||||
{$ASMMODE INTEL}
|
||||
@ -299,10 +300,11 @@ procedure EnterCriticalSection (var CS: TRTLCriticalSection);
|
||||
var
|
||||
P, T, Cnt: longint;
|
||||
PTIB: PThreadInfoBlock;
|
||||
PPIB: PProcessInfoBlock;
|
||||
begin
|
||||
if os_mode = osOS2 then
|
||||
begin
|
||||
DosGetInfoBlocks (@PTIB, nil);
|
||||
DosGetInfoBlocks (@PTIB, @PPIB);
|
||||
DosEnterCritSec;
|
||||
with CS do if (LockCount = 0) and
|
||||
(DosQueryMutExSem (LockSemaphore2, P, T, Cnt) = 0) and (Cnt = 0) and
|
||||
@ -332,12 +334,13 @@ end;
|
||||
procedure LeaveCriticalSection (var CS: TRTLCriticalSection);
|
||||
var
|
||||
PTIB: PThreadInfoBlock;
|
||||
PPIB: PProcessInfoBlock;
|
||||
Err: boolean;
|
||||
begin
|
||||
if os_mode = osOS2 then
|
||||
begin
|
||||
Err := false;
|
||||
DosGetInfoBlocks (@PTIB, nil);
|
||||
DosGetInfoBlocks (@PTIB, @PPIB);
|
||||
DosEnterCritSec;
|
||||
with CS do if OwningThread2 <> PTIB^.TIB2^.TID then
|
||||
begin
|
||||
@ -361,7 +364,10 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.9 2002-09-07 16:01:25 peter
|
||||
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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user