浏览代码

* fixes for OS/2 v2.1 incompatibility

Tomas Hajny 22 年之前
父节点
当前提交
703367dd40
共有 4 个文件被更改,包括 37 次插入18 次删除
  1. 8 3
      fcl/os2/thread.inc
  2. 9 5
      rtl/os2/dos.pas
  3. 10 6
      rtl/os2/doscalls.pas
  4. 10 4
      rtl/os2/thread.inc

+ 8 - 3
fcl/os2/thread.inc

@@ -111,9 +111,10 @@ end;
 function TThread.GetPriority: TThreadPriority;
 function TThread.GetPriority: TThreadPriority;
 var
 var
  PTIB: PThreadInfoBlock;
  PTIB: PThreadInfoBlock;
+ PPIB: PProcessInfoBlock;
  I: TThreadPriority;
  I: TThreadPriority;
 begin
 begin
- DosGetInfoBlocks (@PTIB, nil);
+ DosGetInfoBlocks (@PTIB, @PPIB);
  with PTIB^.TIB2^ do
  with PTIB^.TIB2^ do
   if Priority >= $300 then GetPriority := tpTimeCritical else
   if Priority >= $300 then GetPriority := tpTimeCritical else
       if Priority < $200 then GetPriority := tpIdle else
       if Priority < $200 then GetPriority := tpIdle else
@@ -129,8 +130,9 @@ end;
 procedure TThread.SetPriority(Value: TThreadPriority);
 procedure TThread.SetPriority(Value: TThreadPriority);
 var
 var
  PTIB: PThreadInfoBlock;
  PTIB: PThreadInfoBlock;
+ PPIB: PProcessInfoBlock;
 begin
 begin
- DosGetInfoBlocks (@PTIB, nil);
+ DosGetInfoBlocks (@PTIB, @PPIB);
 (*
 (*
  PTIB^.TIB2^.Priority := Priorities [Value];
  PTIB^.TIB2^.Priority := Priorities [Value];
 *)
 *)
@@ -231,7 +233,10 @@ end;
 
 
 {
 {
   $Log$
   $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
     * old logs removed and tabs fixed
 
 
   Revision 1.5  2002/02/10 13:38:14  hajny
   Revision 1.5  2002/02/10 13:38:14  hajny

+ 9 - 5
rtl/os2/dos.pas

@@ -1161,7 +1161,8 @@ var
  ptr : pchar;
  ptr : pchar;
  base : pchar;
  base : pchar;
  i: integer;
  i: integer;
- tib : pprocessinfoblock;
+ PIB: PProcessInfoBlock;
+ TIB: PThreadInfoBlock;
 begin
 begin
   { We need to setup the environment     }
   { We need to setup the environment     }
   { only in the case of OS/2             }
   { only in the case of OS/2             }
@@ -1170,8 +1171,8 @@ begin
     exit;
     exit;
   cnt := 0;
   cnt := 0;
   { count number of environment pointers }
   { 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 }
   { stringz,stringz...,#0 }
   i := 0;
   i := 0;
   repeat
   repeat
@@ -1188,7 +1189,7 @@ begin
   { got count of environment strings }
   { got count of environment strings }
   GetMem(envp, cnt*sizeof(pchar)+16384);
   GetMem(envp, cnt*sizeof(pchar)+16384);
   cnt := 0;
   cnt := 0;
-  ptr := pchar(tib^.env);
+  ptr := pchar(PIB^.env);
   i:=0;
   i:=0;
   repeat
   repeat
     envp[cnt] := ptr;
     envp[cnt] := ptr;
@@ -1221,7 +1222,10 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     + GetEnvPChar added
 
 
   Revision 1.22  2002/12/07 19:46:56  hajny
   Revision 1.22  2002/12/07 19:46:56  hajny

+ 10 - 6
rtl/os2/doscalls.pas

@@ -165,12 +165,13 @@ type    PThreadInfoBlock=^TThreadInfoBlock;
         ProcessInfoBlock=TProcessInfoBlock;
         ProcessInfoBlock=TProcessInfoBlock;
 
 
 {OS/2 keeps information about the current process and the current thread
 {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
  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;
 procedure DosGetInfoBlocks(var ATIB:PThreadInfoBlock;
                            var APIB:PProcessInfoBlock); cdecl;
                            var APIB:PProcessInfoBlock); cdecl;
@@ -4534,7 +4535,10 @@ external 'DOSCALLS' index 582;
 end.
 end.
 {
 {
   $Log$
   $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
     * DosCalls not using Objects any more
 
 
   Revision 1.18  2002/11/14 21:16:22  hajny
   Revision 1.18  2002/11/14 21:16:22  hajny

+ 10 - 4
rtl/os2/thread.inc

@@ -176,10 +176,11 @@ end;
 procedure DoneThread;
 procedure DoneThread;
 var
 var
  PTIB: PThreadInfoBlock;
  PTIB: PThreadInfoBlock;
+ PPIB: PProcessInfoBlock;
  ThreadID: longint;
  ThreadID: longint;
 begin
 begin
  ReleaseThreadVars;
  ReleaseThreadVars;
- DosGetInfoBlocks (@PTIB, nil);
+ DosGetInfoBlocks (@PTIB, @PPIB);
  ThreadID := PTIB^.TIB2^.TID;
  ThreadID := PTIB^.TIB2^.TID;
 {$IFDEF EMX}
 {$IFDEF EMX}
 {$ASMMODE INTEL}
 {$ASMMODE INTEL}
@@ -299,10 +300,11 @@ procedure EnterCriticalSection (var CS: TRTLCriticalSection);
 var
 var
  P, T, Cnt: longint;
  P, T, Cnt: longint;
  PTIB: PThreadInfoBlock;
  PTIB: PThreadInfoBlock;
+ PPIB: PProcessInfoBlock;
 begin
 begin
  if os_mode = osOS2 then
  if os_mode = osOS2 then
  begin
  begin
-  DosGetInfoBlocks (@PTIB, nil);
+  DosGetInfoBlocks (@PTIB, @PPIB);
   DosEnterCritSec;
   DosEnterCritSec;
   with CS do if (LockCount = 0) and
   with CS do if (LockCount = 0) and
     (DosQueryMutExSem (LockSemaphore2, P, T, Cnt) = 0) and (Cnt = 0) and
     (DosQueryMutExSem (LockSemaphore2, P, T, Cnt) = 0) and (Cnt = 0) and
@@ -332,12 +334,13 @@ end;
 procedure LeaveCriticalSection (var CS: TRTLCriticalSection);
 procedure LeaveCriticalSection (var CS: TRTLCriticalSection);
 var
 var
  PTIB: PThreadInfoBlock;
  PTIB: PThreadInfoBlock;
+ PPIB: PProcessInfoBlock;
  Err: boolean;
  Err: boolean;
 begin
 begin
  if os_mode = osOS2 then
  if os_mode = osOS2 then
  begin
  begin
   Err := false;
   Err := false;
-  DosGetInfoBlocks (@PTIB, nil);
+  DosGetInfoBlocks (@PTIB, @PPIB);
   DosEnterCritSec;
   DosEnterCritSec;
   with CS do if OwningThread2 <> PTIB^.TIB2^.TID then
   with CS do if OwningThread2 <> PTIB^.TIB2^.TID then
   begin
   begin
@@ -361,7 +364,10 @@ end;
 
 
 {
 {
   $Log$
   $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
     * old logs removed and tabs fixed
 
 
   Revision 1.8  2002/07/07 18:04:39  hajny
   Revision 1.8  2002/07/07 18:04:39  hajny