* added (limited) GetLastOSError by emulation of Win32 and *nix behaviour in the RTL

git-svn-id: trunk@28947 -

rtl/os2/dos.pas

@@ -113,6 +113,8 @@ begin
   P:=Path;
   D:=DirList;
   DosError := DosSearchPath (dsIgnoreNetErrs, PChar(D), PChar(P), @A, 255);
+  if DosError <> 0 then
+   OSErrorWatch (DosError);
   fsearch := StrPas (@A);
 end;
 
@@ -124,12 +126,16 @@ begin
   DosError := DosQueryFileInfo (FileRec (F).Handle, ilStandard, @FStat,
                                                                SizeOf (FStat));
   if DosError=0 then
-  begin
+   begin
     Time := FStat.TimeLastWrite + longint (FStat.DateLastWrite) shl 16;
     if Time = 0 then
       Time := FStat.TimeCreation + longint (FStat.DateCreation) shl 16;
-  end else
+   end
+  else
+   begin
     Time:=0;
+    OSErrorWatch (DosError);
+   end;
 end;
 
 
@@ -140,14 +146,18 @@ begin
   RC := DosQueryFileInfo (FileRec (F).Handle, ilStandard, @FStat,
                                                                SizeOf (FStat));
   if RC = 0 then
-  begin
+   begin
     FStat.DateLastAccess := Hi (Time);
     FStat.DateLastWrite := Hi (Time);
     FStat.TimeLastAccess := Lo (Time);
     FStat.TimeLastWrite := Lo (Time);
     RC := DosSetFileInfo (FileRec (F).Handle, ilStandard, @FStat,
                                                                SizeOf (FStat));
-  end;
+    if RC <> 0 then
+     OSErrorWatch (RC);
+   end
+  else
+   OSErrorWatch (RC);
   DosError := integer (RC);
 end;
 
@@ -170,7 +180,10 @@ begin
       LastExecRes := Res;
      end
     else
-     LastExecRes.ExitCode := RC shl 16;
+     begin
+      LastExecRes.ExitCode := RC shl 16;
+      OSErrorWatch (RC);
+     end;
    end;
   if LastExecRes.ExitCode > high (word) then
     DosExitCode := high (word)
@@ -186,7 +199,7 @@ var
   ArgSize: word;
   ObjName: string;
   Res: TResultCodes;
-  RC: cardinal;
+  RC, RC2: cardinal;
   ExecAppType: cardinal;
   HQ: THandle;
   SPID, STID, SCtr, QName: string;
@@ -239,22 +252,28 @@ begin
     Args^ [ArgSize] := 0;
    end;
 
-  if (DosQueryAppType (PChar (Args), ExecAppType) = 0) and
-                               (ApplicationType and 3 = ExecAppType and 3) then
+  RC := DosQueryAppType (PChar (Args), ExecAppType);
+  if RC <> 0 then
+   OSErrorWatch (RC)
+  else
+   if (ApplicationType and 3 = ExecAppType and 3) then
 (* DosExecPgm should work... *)
-   begin
-    DSS := false;
-    Res.ExitCode := $FFFFFFFF;
-    RC := DosExecPgm (ObjName, cardinal (ExecFlags), Args, nil, Res, Path);
-    if RC = 0 then
-     begin
-      LastExecFlags := ExecFlags;
-      LastExecRes := Res;
-      LastDosErrorModuleName := '';
-     end
-    else
-     if (RC = 190) or (RC = 191) then
-      DSS := true;
+    begin
+     DSS := false;
+     Res.ExitCode := $FFFFFFFF;
+     RC := DosExecPgm (ObjName, cardinal (ExecFlags), Args, nil, Res, Path);
+     if RC = 0 then
+      begin
+       LastExecFlags := ExecFlags;
+       LastExecRes := Res;
+       LastDosErrorModuleName := '';
+      end
+     else
+      begin
+       if (RC = 190) or (RC = 191) then
+        DSS := true;
+       OSErrorWatch (RC);
+      end;
    end
   else
    DSS := true;
@@ -273,6 +292,8 @@ begin
        LastExecFlags := ExecFlags;
        SD.TermQ := @QName [1];
        RC := DosCreateQueue (HQ, quFIFO or quConvert_Address, @QName [1]);
+       if RC <> 0 then
+        OSErrorWatch (RC);
       end;
      deAsync,
      deAsyncResult:
@@ -318,24 +339,40 @@ begin
       SD.ObjectBuffer := @ObjName [1];
       SD.ObjectBuffLen := SizeOf (ObjName) - 1;
       RC := DosStartSession (SD, SID, PID);
+      if RC <> 0 then
+       OSErrorWatch (RC);
       if (RC = 0) or (RC = 457) then
        begin
         LastExecRes.PID := PID;
         if ExecFlags = deSync then
          begin
           RC := DosReadQueue (HQ, RD, CISize, PCI, 0, 0, Prio, 0);
+          if RC <> 0 then
+           OSErrorWatch (RC);
           if (RC = 0) and (PCI^.SessionID = SID) then
            begin
             LastExecRes.ExitCode := PCI^.Return;
-            DosCloseQueue (HQ);
-            DosFreeMem (PCI);
+            RC2 := DosCloseQueue (HQ);
+            if RC2 <> 0 then
+             OSErrorWatch (RC2);
+            RC2 := DosFreeMem (PCI);
+            if RC2 <> 0 then
+             OSErrorWatch (RC2);
            end
           else
-           DosCloseQueue (HQ);
+           begin
+            RC2 := DosCloseQueue (HQ);
+            if RC2 <> 0 then
+             OSErrorWatch (RC2);
+           end;
          end;
        end
       else if ExecFlags = deSync then
-       DosCloseQueue (HQ);
+       begin
+        RC2 := DosCloseQueue (HQ);
+        if RC2 <> 0 then
+         OSErrorWatch (RC2);
+       end;
      end;
    end;
   if RC <> 0 then
@@ -383,12 +420,15 @@ end;
 procedure SetDate (Year, Month, Day: word);
 var
   DT: TDateTime;
+  RC: cardinal;
 begin
   DosGetDateTime (DT);
   DT.Year := Year;
   DT.Month := byte (Month);
   DT.Day := byte (Day);
-  DosSetDateTime (DT);
+  RC := DosSetDateTime (DT);
+  if RC <> 0 then
+   OSErrorWatch (RC);
 end;
 
 
@@ -407,6 +447,7 @@ end;
 procedure SetTime (Hour, Minute, Second, Sec100: word);
 var
   DT: TDateTime;
+  RC: cardinal;
 begin
   DosGetDateTime (DT);
   DT.Hour := byte (Hour);
@@ -414,6 +455,8 @@ begin
   DT.Second := byte (Second);
   DT.Sec100 := byte (Sec100);
   DosSetDateTime (DT);
+  if RC <> 0 then
+   OSErrorWatch (RC);
 end;
 
 function DiskFree (Drive: byte): int64;
@@ -426,7 +469,10 @@ begin
       DiskFree := int64 (FI.Free_Clusters) *
          int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
   else
-      DiskFree := -1;
+   begin
+    DiskFree := -1;
+    OSErrorWatch (RC);
+   end;
 end;
 
 
@@ -439,7 +485,10 @@ begin
       DiskSize := int64 (FI.Total_Clusters) *
          int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
   else
-      DiskSize := -1;
+   begin
+    DiskSize := -1;
+    OSErrorWatch (RC);
+   end;
 end;
 
 
@@ -474,7 +523,10 @@ begin
   DosError := integer (DosFindFirst (Path, F.Handle,
                      Attr and FindResvdMask, F.FStat, SizeOf (F.FStat^),
                                                            Count, ilStandard));
-  if (DosError = 0) and (Count = 0) then DosError := 18;
+  if DosError <> 0 then
+   OSErrorWatch (DosError)
+  else if Count = 0 then
+   DosError := 18;
   DosSearchRec2SearchRec (F);
 end;
 
@@ -488,14 +540,22 @@ begin
     Count := 1;
     DosError := integer (DosFindNext (F.Handle, F.FStat, SizeOf (F.FStat^),
                                                                        Count));
-    if (DosError = 0) and (Count = 0) then DosError := 18;
+    if DosError <> 0 then
+     OSErrorWatch (DosError)
+    else if Count = 0 then
+     DosError := 18;
     DosSearchRec2SearchRec (F);
 end;
 
 
 procedure FindClose (var F: SearchRec);
 begin
-  if F.Handle <> THandle ($FFFFFFFF) then DosError := DosFindClose (F.Handle);
+  if F.Handle <> THandle ($FFFFFFFF) then
+   begin
+    DosError := integer (DosFindClose (F.Handle));
+    if DosError <> 0 then
+     OSErrorWatch (DosError);
+   end;
   Dispose (F.FStat);
 end;
 
@@ -607,7 +667,9 @@ begin
   RC := DosQueryPathInfo (P, ilStandard, @PathInfo, SizeOf (PathInfo));
   DosError := integer (RC);
   if RC = 0 then
-    Attr := PathInfo.AttrFile;
+    Attr := PathInfo.AttrFile
+  else
+   OSErrorWatch (RC);
 end;
 
 
@@ -628,11 +690,15 @@ begin
 {$endif FPC_ANSI_TEXTFILEREC}
   RC := DosQueryPathInfo (P, ilStandard, @PathInfo, SizeOf (PathInfo));
   if RC = 0 then
-  begin
+   begin
     PathInfo.AttrFile := Attr;
     RC := DosSetPathInfo (P, ilStandard, @PathInfo, SizeOf (PathInfo),
                                                         doWriteThru);
-  end;
+    if RC <> 0 then
+     OSErrorWatch (RC);
+   end
+  else
+   OSErrorWatch (RC);
   DosError := integer (RC);
 end;
 

rtl/os2/dynlibs.inc

@@ -54,7 +54,10 @@ begin
  if DynLibErrNo = 0 then
   Result := Handle
  else
-  Result := NilHandle;
+  begin
+   Result := NilHandle;
+   OSErrorWatch (DynLibErrNo);
+  end;
 end;
 
 function GetProcedureAddress (Lib: TLibHandle; const ProcName: AnsiString): pointer;
@@ -66,7 +69,10 @@ begin
  if DynLibErrNo = 0 then
   Result := P
  else
-  Result := nil;
+  begin
+   Result := nil;
+   OSErrorWatch (DynLibErrNo);
+  end;
 end;
 
 function GetProcedureAddress (Lib: TLibHandle; Ordinal: TOrdinalEntry): pointer;
@@ -78,7 +84,10 @@ begin
  if DynLibErrNo = 0 then
   Result := P
  else
-  Result := nil;
+  begin
+   Result := nil;
+   OSErrorWatch (DynLibErrNo);
+  end;
 end;
 
 function UnloadLibrary (Lib: TLibHandle): boolean;
@@ -86,6 +95,8 @@ begin
  DynLibErrPath [0] := #0;
  DynLibErrNo := DosFreeModule (Lib);
  Result := DynLibErrNo = 0;
+ if DynLibErrNo <> 0 then
+  OSErrorWatch (DynLibErrNo);
 end;
 
 function GetDynLibsError: longint;
@@ -102,22 +113,26 @@ var
  RetMsgSize: cardinal;
  RC: cardinal;
 begin
- if DynLibErrNo = 0 then
-  GetDynLibsErrorStr := ''
- else
+ GetDynLibsErrorStr := '';
+ if DynLibErrNo <> 0 then
   begin
+   Result := '';
    VarArr [1] := @DynLibErrPath [0];
    RC := DosGetMessage (@VarArr, 1, @OutBuf [0], SizeOf (OutBuf),
                                      DynLibErrNo, @SysMsgFile [0], RetMsgSize);
    if RC = 0 then
-    Result := StrPas (@OutBuf [0])
+    begin
+     SetLength (Result, RetMsgSize);
+     Move (OutBuf [0], Result [1], RetMsgSize);
+    end
    else
     begin
      Str (DynLibErrNo, Result);
      Result := 'Error ' + Result;
+     if DynLibErrPath [0] <> #0 then
+      Result := StrPas (@DynLibErrPath [0]) + ' - ' + Result;
+     OSErrorWatch (RC);
     end;
-   if DynLibErrPath [0] <> #0 then
-    Result := StrPas (@DynLibErrPath [0]) + ' - ' + Result;
   end;
 end;
 

rtl/os2/sysdir.inc

@@ -29,6 +29,7 @@ begin
     begin
       InOutRes := Rc;
       Errno2Inoutres;
+      OSErrorWatch (RC);
     end;
 end;
 
@@ -47,6 +48,7 @@ begin
     begin
       InOutRes := Rc;
       Errno2Inoutres;
+      OSErrorWatch (RC);
     end;
 end;
 
@@ -63,7 +65,10 @@ begin
   begin
     RC := DosSetDefaultDisk ((Ord (S [1]) and not ($20)) - $40);
     if RC <> 0 then
-      InOutRes := RC
+     begin
+      InOutRes := RC;
+      OSErrorWatch (RC);
+     end
     else
       if Len > 2 then
       begin
@@ -75,6 +80,7 @@ begin
         begin
           InOutRes := RC;
           Errno2InOutRes;
+          OSErrorWatch (RC);
         end;
       end;
   end else begin
@@ -86,6 +92,7 @@ begin
     begin
       InOutRes:= RC;
       Errno2InOutRes;
+      OSErrorWatch (RC);
     end;
   end;
 end;
@@ -97,6 +104,7 @@ procedure do_GetDir (DriveNr: byte; var Dir: RawByteString);
 var sof: Pchar;
     i:byte;
     l,l2:cardinal;
+    RC: cardinal;
 begin
     setlength(Dir,255);
     Dir [4] := #0;
@@ -109,7 +117,13 @@ begin
     { TODO: if max path length is > 255, increase the setlength parameter above and
       the 255 below }
     l:=255-3;
-    InOutRes:=longint (DosQueryCurrentDir(DriveNr, sof^, l));
+    RC := DosQueryCurrentDir(DriveNr, sof^, l);
+    if RC <> 0 then
+     begin
+      InOutRes := longint (RC);
+      Errno2Inoutres;
+      OSErrorWatch (RC);
+     end;
 {$WARNING Result code should be translated in some cases!}
     { Now Dir should be filled with directory in ASCIIZ, }
     { starting from dir[4]                               }

rtl/os2/sysfile.inc

@@ -2,7 +2,7 @@
     This file is part of the Free Pascal run time library.
     Copyright (c) 2001 by Free Pascal development team
 
-    Low leve file functions
+    Low level file functions
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -20,12 +20,19 @@
 ****************************************************************************}
 
 procedure do_close(h:thandle);
+var
+  RC: cardinal;
 begin
 { Only three standard handles under real OS/2 }
   if h>2 then
-  begin
-    InOutRes:=DosClose(h);
-  end;
+   begin
+    RC := DosClose (H);
+    if RC <> 0 then
+     begin
+      InOutRes := longint (RC);
+      OSErrorWatch (RC);
+     end;
+   end;
 {$ifdef IODEBUG}
   writeln('do_close: handle=', H, ', InOutRes=', InOutRes);
 {$endif}
@@ -34,10 +41,16 @@ end;
 procedure do_erase(p:Pchar; pchangeable: boolean);
 var
   oldp: pchar;
+  RC: cardinal;
 begin
   oldp:=p;
   DoDirSeparators(p,pchangeable);
-  inoutres:=DosDelete(p);
+  RC := DosDelete (P);
+  if RC <> 0 then
+   begin
+    InOutRes := longint (RC);
+    OSErrorWatch (RC);
+   end;
   if p<>oldp then
     freemem(p);
 end;
@@ -45,12 +58,18 @@ end;
 procedure do_rename(p1,p2:Pchar; p1changeable, p2changeable: boolean);
 var
   oldp1, oldp2 : pchar;
+  RC: cardinal;
 begin
   oldp1:=p1;
   oldp2:=p2;
   DoDirSeparators(p1,p1changeable);
   DoDirSeparators(p2,p2changeable);
-  inoutres:=DosMove(p1, p2);
+  RC := DosMove (p1, p2);
+  if RC <> 0 then
+   begin
+    InOutRes := longint (RC);
+    OSErrorWatch (RC);
+   end;
   if p1<>oldp1 then
     freemem(p1);
   if p2<>oldp2 then
@@ -60,11 +79,17 @@ end;
 function do_read(h:thandle;addr:pointer;len:longint):longint;
 Var
   T: cardinal;
+  RC: cardinal;
 begin
 {$ifdef IODEBUG}
   write('do_read: handle=', h, ', addr=', ptrint(addr), ', length=', len);
 {$endif}
-  InOutRes:=DosRead(H, Addr, Len, T);
+  RC := DosRead(H, Addr, Len, T);
+  if RC <> 0 then
+   begin
+    InOutRes := longint (RC);
+    OSErrorWatch (RC);
+   end;
   do_read:= longint (T);
 {$ifdef IODEBUG}
   writeln(', actual_len=', t, ', InOutRes=', InOutRes);
@@ -74,11 +99,17 @@ end;
 function do_write(h:thandle;addr:pointer;len:longint) : longint;
 Var
   T: cardinal;
+  RC: cardinal;
 begin
 {$ifdef IODEBUG}
   write('do_write: handle=', h, ', addr=', ptrint(addr), ', length=', len);
 {$endif}
-  InOutRes:=DosWrite(H, Addr, Len, T);
+  RC := DosWrite(H, Addr, Len, T);
+  if RC <> 0 then
+   begin
+    InOutRes := longint (RC);
+    OSErrorWatch (RC);
+   end;
   do_write:= longint (T);
 {$ifdef IODEBUG}
   writeln(', actual_len=', t, ', InOutRes=', InOutRes);
@@ -88,8 +119,14 @@ end;
 function Do_FilePos (Handle: THandle): int64;
 var
   PosActual: int64;
+  RC: cardinal;
 begin
-  InOutRes := Sys_DosSetFilePtrL (Handle, 0, 1, PosActual);
+  RC := Sys_DosSetFilePtrL (Handle, 0, 1, PosActual);
+  if RC <> 0 then
+   begin
+    InOutRes := longint (RC);
+    OSErrorWatch (RC);
+   end;
   Do_FilePos := PosActual;
 {$ifdef IODEBUG}
   writeln('do_filepos: handle=', Handle, ', actual_pos=', PosActual, ', InOutRes=', InOutRes);
@@ -99,8 +136,14 @@ end;
 procedure Do_Seek (Handle: THandle; Pos: int64);
 var
   PosActual: int64;
+  RC: cardinal;
 begin
-  InOutRes:=Sys_DosSetFilePtrL(Handle, Pos, 0 {ZeroBased}, PosActual);
+  RC := Sys_DosSetFilePtrL(Handle, Pos, 0 {ZeroBased}, PosActual);
+  if RC <> 0 then
+   begin
+    InOutRes := longint (RC);
+    OSErrorWatch (RC);
+   end;
 {$ifdef IODEBUG}
   writeln('do_seek: handle=', Handle, ', pos=', pos, ', actual_pos=', PosActual, ', InOutRes=', InOutRes);
 {$endif}
@@ -109,9 +152,17 @@ end;
 function Do_SeekEnd (Handle: THandle): int64;
 var
   PosActual: int64;
+  RC: cardinal;
 begin
-  InOutRes := Sys_DosSetFilePtrL (Handle, 0, 2 {EndBased}, PosActual);
-  Do_SeekEnd := PosActual;
+  RC := Sys_DosSetFilePtrL (Handle, 0, 2 {EndBased}, PosActual);
+  if RC <> 0 then
+   begin
+    InOutRes := longint (RC);
+    OSErrorWatch (RC);
+    Do_SeekEnd := -1;
+   end
+  else
+   Do_SeekEnd := PosActual;
 {$ifdef IODEBUG}
   writeln('do_seekend: handle=', Handle, ', actual_pos=', PosActual, ', InOutRes=', InOutRes);
 {$endif}
@@ -122,14 +173,25 @@ var
   AktFilePos: int64;
 begin
   AktFilePos := Do_FilePos (Handle);
-  Do_FileSize := Do_SeekEnd (Handle);
-  Do_Seek (Handle, AktFilePos);
+  if InOutRes = 0 then
+   begin
+    Do_FileSize := Do_SeekEnd (Handle);
+    Do_Seek (Handle, AktFilePos);
+   end;
 end;
 
 procedure Do_Truncate (Handle: THandle; Pos: int64);
+var
+  RC: cardinal;
 begin
-  InOutRes := Sys_DosSetFileSizeL (Handle, Pos);
-  Do_SeekEnd (Handle);
+  RC := Sys_DosSetFileSizeL (Handle, Pos);
+  if RC <> 0 then
+   begin
+    InOutRes := longint (RC);
+    OSErrorWatch (RC);
+   end
+  else
+   Do_SeekEnd (Handle);
 end;
 
 
@@ -140,18 +202,23 @@ function Increase_File_Handle_Count: boolean;
 var Err: word;
     L1: longint;
     L2: cardinal;
+    RC: cardinal;
 begin
   L1 := 10;
-  if DosSetRelMaxFH (L1, L2) <> 0 then
-    Increase_File_Handle_Count := false
+  RC := DosSetRelMaxFH (L1, L2);
+  if RC <> 0 then
+   begin
+    Increase_File_Handle_Count := false;
+    OSErrorWatch (RC);
+   end
   else
-    if L2 > FileHandleCount then
+   if L2 > FileHandleCount then
     begin
       FileHandleCount := L2;
       Increase_File_Handle_Count := true;
     end
-    else
-      Increase_File_Handle_Count := false;
+   else
+    Increase_File_Handle_Count := false;
 end;
 
 procedure do_open(var f;p:pchar;flags:longint; pchangeable: boolean);
@@ -166,13 +233,13 @@ procedure do_open(var f;p:pchar;flags:longint; pchangeable: boolean);
 var
   Action, Attrib, OpenFlags, FM: Cardinal;
   oldp : pchar;
+  RC: cardinal;
 begin
-
   // close first if opened
   if ((flags and $10000)=0) then
   begin
     case filerec(f).mode of
-      fminput,fmoutput,fminout : Do_Close(filerec(f).handle);
+      fminput,fmoutput,fminout : Do_Close (FileRec (F).Handle);
       fmclosed:;
     else
       begin
@@ -228,14 +295,26 @@ begin
   DoDirSeparators(p,pchangeable);
   Attrib:=32 {faArchive};
 
-  InOutRes:=Sys_DosOpenL(p, FileRec(F).Handle, Action, 0, Attrib, OpenFlags, FM, nil);
+  RC := Sys_DosOpenL(p, FileRec(F).Handle, Action, 0, Attrib, OpenFlags, FM, nil);
+  if RC <> 0 then
+   begin
+    InOutRes := longint (RC);
+    OSErrorWatch (RC);
+   end;
 
   // If too many open files try to set more file handles and open again
   if (InOutRes = 4) then
-    if Increase_File_Handle_Count then
-      InOutRes:=Sys_DosOpenL(p, FileRec(F).Handle, Action, 0, Attrib, OpenFlags, FM, nil);
-
-  If InOutRes<>0 then FileRec(F).Handle:=UnusedHandle;
+   if Increase_File_Handle_Count then
+    begin
+     RC := Sys_DosOpenL(p, FileRec(F).Handle, Action, 0, Attrib, OpenFlags, FM, nil);
+     if RC <> 0 then
+      begin
+       InOutRes := longint (RC);
+       OSErrorWatch (RC);
+      end;
+    end;
+  if RC <> 0 then
+   FileRec(F).Handle:=UnusedHandle;
 
   // If Handle created -> make some things
   if (FileRec(F).Handle <> UnusedHandle) then
@@ -261,9 +340,16 @@ end;
 function do_isdevice (Handle: THandle): boolean;
 var
   HT, Attr: cardinal;
+  RC: cardinal;
 begin
   do_isdevice:=false;
-  If DosQueryHType(Handle, HT, Attr)<>0 then exit;
-  if ht=1 then do_isdevice:=true;
+  RC := DosQueryHType(Handle, HT, Attr);
+  if RC <> 0 then
+   begin
+    OSErrorWatch (RC);
+    Exit;
+   end;
+  if ht=1 then
+   do_isdevice:=true;
 end;
 {$ASMMODE ATT}

rtl/os2/sysheap.inc

@@ -1,10 +1,8 @@
 {
     This file is part of the Free Pascal run time library.
-    Copyright (c) 2001 by Free Pascal development team
+    Copyright (c) 2001-2014 by Free Pascal development team
 
-    This file implements all the base types and limits required
-    for a minimal POSIX compliant subset required to port the compiler
-    to a new OS.
+    This file implements heap management for OS/2.
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -87,6 +85,7 @@ begin
   else
    begin
     SysOSAlloc := nil;
+    OSErrorWatch (RC);
 {$IFDEF EXTDUMPGROW}
     if Int_HeapSize <> high (cardinal) then
      begin
@@ -104,25 +103,23 @@ end;
 {$define HAS_SYSOSFREE}
 
 procedure SysOSFree (P: pointer; Size: ptruint);
-{$IFDEF EXTDUMPGROW}
 var
   RC: cardinal;
-{$ENDIF EXTDUMPGROW}
 begin
 {$IFDEF EXTDUMPGROW}
   WriteLn ('Trying to free memory!');
   WriteLn ('Total allocated memory is ', Int_HeapSize);
   Dec (Int_HeapSize, Size);
-  RC :=
 {$ENDIF EXTDUMPGROW}
-        DosFreeMem (P);
-{$IFDEF EXTDUMPGROW}
+  RC := DosFreeMem (P);
   if RC <> 0 then
    begin
+    OSErrorWatch (RC);
+{$IFDEF EXTDUMPGROW}
     WriteLn ('Error ', RC, ' during memory deallocation (DosFreeMem)!');
     WriteLn ('Total allocated memory is ', Int_HeapSize);
-   end;
 {$ENDIF EXTDUMPGROW}
+   end;
 end;
 
 

rtl/os2/sysos.inc

@@ -54,7 +54,7 @@ type
 var
   ProcessID: SizeUInt;
 
-function GetProcessID:SizeUInt;
+function GetProcessID: SizeUInt;
 begin
  GetProcessID := ProcessID;
 end;
@@ -420,3 +420,11 @@ external 'DOSCALLS' index 306;
 function DosQuerySysInfo (First, Last: cardinal; var Buf; BufSize: cardinal):
                                                                cardinal; cdecl;
 external 'DOSCALLS' index 348;
+
+type
+ TCPArray = array [0..2] of cardinal;
+ PCPArray = ^TCPArray;
+
+function DosQueryCP (Size: cardinal; CodePages: PCPArray;
+                                       var ActSize: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 291;

rtl/os2/system.pas

@@ -110,6 +110,20 @@ const
 (* Are file sizes > 2 GB (64-bit) supported on the current system? *)
   FSApi64: boolean = false;
 
+(* Support for tracking I/O errors returned by OS/2 API calls - emulation *)
+(* of GetLastError / fpGetError functionality used e.g. in Sysutils.      *)
+type
+ TOSErrorWatch = procedure (Error: cardinal);
+
+procedure NoErrorTracking (Error: cardinal);
+
+(* This shall be invoked whenever a non-zero error is returned by OS/2 APIs *)
+(* used in the RTL. Direct OS/2 API calls in user programs are not covered! *)
+const
+ OSErrorWatch: TOSErrorWatch = @NoErrorTracking;
+
+
+procedure SetOSErrorTracking (P: pointer);
 
 procedure SetDefaultOS2FileType (FType: ShortString);
 
@@ -174,12 +188,15 @@ function Is_Prefetch (P: pointer): boolean;
     InstrLo, InstrHi, OpCode: byte;
     I: longint;
     MemSize, MemAttrs: cardinal;
+    RC: cardinal;
   begin
     Is_Prefetch := false;
 
     MemSize := SizeOf (A);
-    if (DosQueryMem (P, MemSize, MemAttrs) = 0) and
-            (MemAttrs and (mfPag_Free or mfPag_Commit) <> 0)
+    RC := DosQueryMem (P, MemSize, MemAttrs);
+    if RC <> 0 then
+     OSErrorWatch (RC)
+    else if (MemAttrs and (mfPag_Free or mfPag_Commit) <> 0)
                                                and (MemSize >= SizeOf (A)) then
      Move (P^, A [0], SizeOf (A))
     else
@@ -289,6 +306,7 @@ var
  Res: cardinal;
  Err: byte;
  Must_Reset_FPU: boolean;
+ RC: cardinal;
 {$IFDEF SYSTEMEXCEPTIONDEBUG}
  CurSS: cardinal;
  B: byte;
@@ -382,7 +400,9 @@ begin
 {$ENDIF SYSTEMEXCEPTIONDEBUG}
           Report^.Exception_Num := 0;
           Res := Xcpt_Continue_Execution;
-          DosAcknowledgeSignalException (Report^.Parameters [0]);
+          RC := DosAcknowledgeSignalException (Report^.Parameters [0]);
+          if RC <> 0 then
+           OSErrorWatch (RC);
          end
         else
          Err := 217;
@@ -443,7 +463,9 @@ begin
 {$ENDIF SYSTEMEXCEPTIONDEBUG}
      Report^.Exception_Num := 0;
      Res := Xcpt_Continue_Execution;
-     DosAcknowledgeSignalException (Report^.Parameters [0]);
+     RC := DosAcknowledgeSignalException (Report^.Parameters [0]);
+     if RC <> 0 then
+      OSErrorWatch (RC);
     end
    else
     Err := 217;
@@ -504,6 +526,7 @@ var
 procedure Install_Exception_Handler;
 var
  T: cardinal;
+ RC: cardinal;
 begin
 {$ifdef SYSTEMEXCEPTIONDEBUG}
 (* ThreadInfoBlock is located at FS:[0], the first      *)
@@ -524,9 +547,15 @@ begin
  DosSetExceptionHandler (ExcptReg^);
  if IsConsole then
   begin
-   DosSetSignalExceptionFocus (1, T);
-   DosAcknowledgeSignalException (Xcpt_Signal_Intr);
-   DosAcknowledgeSignalException (Xcpt_Signal_Break);
+   RC := DosSetSignalExceptionFocus (1, T);
+   if RC <> 0 then
+    OSErrorWatch (RC);
+   RC := DosAcknowledgeSignalException (Xcpt_Signal_Intr);
+   if RC <> 0 then
+    OSErrorWatch (RC);
+   RC := DosAcknowledgeSignalException (Xcpt_Signal_Break);
+   if RC <> 0 then
+    OSErrorWatch (RC);
   end;
 {$ifdef SYSTEMEXCEPTIONDEBUG}
  asm
@@ -538,8 +567,10 @@ begin
 end;
 
 procedure Remove_Exception_Handlers;
+var
+  RC: cardinal;
 begin
-  DosUnsetExceptionHandler (ExcptReg^);
+  RC := DosUnsetExceptionHandler (ExcptReg^);
 end;
 {$ENDIF OS2EXCEPTIONS}
 
@@ -686,6 +717,10 @@ begin
 end;
 
 procedure SysInitStdIO;
+(*
+var
+  RC: cardinal;
+*)
 begin
   { Setup stdin, stdout and stderr, for GUI apps redirect stderr,stdout to be
     displayed in a messagebox }
@@ -695,21 +730,36 @@ begin
   StdErrorHandle := longint(GetStdHandle(cardinal(STD_ERROR_HANDLE)));
 
   if not IsConsole then
-    begin
-      if (DosLoadModule (nil, 0, 'PMWIN', PMWinHandle) = 0) and
-       (DosQueryProcAddr (PMWinHandle, 789, nil, pointer (WinMessageBox)) = 0)
-                                                                           and
-       (DosQueryProcAddr (PMWinHandle, 763, nil, pointer (WinInitialize)) = 0)
-                                                                           and
-       (DosQueryProcAddr (PMWinHandle, 716, nil, pointer (WinCreateMsgQueue))
-                                                                           = 0)
-        then
-          begin
+   begin
+    RC := DosLoadModule (nil, 0, 'PMWIN', PMWinHandle);
+    if RC <> 0 then
+     OSErrorWatch (RC)
+    else
+     begin
+      RC := DosQueryProcAddr (PMWinHandle, 789, nil, pointer (WinMessageBox));
+      if RC <> 0 then
+       OSErrorWatch (RC)
+      else
+       begin
+        RC := DosQueryProcAddr (PMWinHandle, 763, nil, pointer (WinInitialize));
+        if RC <> 0 then
+         OSErrorWatch (RC)
+        else
+         begin
+          RC := DosQueryProcAddr (PMWinHandle, 716, nil, pointer (WinCreateMsgQueue));
+          if RC <> 0 then
+           OSErrorWatch (RC)
+          else
+           begin
             WinInitialize (0);
             WinCreateMsgQueue (0, 0);
-          end
-        else
-          HandleError (2);
+           end
+         end
+       end
+     end;
+    if RC <> 0 then
+     HandleError (2);
+
      AssignError (StdErr);
      AssignError (StdOut);
      Assign (Output, '');
@@ -824,6 +874,21 @@ begin
 end;
 
 
+(* The default handler does not store the OS/2 API error codes. *)
+procedure NoErrorTracking (Error: cardinal);
+begin
+end;
+
+
+procedure SetOSErrorTracking (P: pointer);
+begin
+ if P = nil then
+  OSErrorWatch := @NoErrorTracking
+ else
+  OSErrorWatch := TOSErrorWatch (P);
+end;
+
+
 procedure InitEnvironment;
 var env_count : longint;
     dos_env,cp : pchar;
@@ -870,6 +935,7 @@ var
   pc,arg  : pchar;
   quote   : char;
   argvlen : PtrInt;
+  RC: cardinal;
 
   procedure allocarg(idx,len: PtrInt);
     var
@@ -896,7 +962,8 @@ begin
   ArgLen := StrLen (PChar (PIB^.Cmd));
   Inc (ArgLen);
 
-  if DosQueryModuleName (PIB^.Handle, MaxPathLen, CmdLine) = 0 then
+  RC := DosQueryModuleName (PIB^.Handle, MaxPathLen, CmdLine);
+  if RC = 0 then
    ArgVLen := Succ (StrLen (CmdLine))
   else
 (* Error occurred - use program name from command line as fallback. *)
@@ -1070,10 +1137,17 @@ end;
 function GetFileHandleCount: longint;
 var L1: longint;
     L2: cardinal;
+    RC: cardinal;
 begin
     L1 := 0; (* Don't change the amount, just check. *)
-    if DosSetRelMaxFH (L1, L2) <> 0 then GetFileHandleCount := 50
-                                                 else GetFileHandleCount := L2;
+    RC := DosSetRelMaxFH (L1, L2);
+    if RC <> 0 then
+     begin
+      GetFileHandleCount := 50;
+      OSErrorWatch (RC);
+     end
+    else
+     GetFileHandleCount := L2;
 end;
 
 function CheckInitialStkLen (StkLen: SizeUInt): SizeUInt;
@@ -1086,6 +1160,8 @@ var TIB: PThreadInfoBlock;
     ErrStr: string;
     P: pointer;
     DW: cardinal;
+    CPArr: TCPArray;
+    ReturnedSize: cardinal;
 
 const
     DosCallsName: array [0..8] of char = 'DOSCALLS'#0;
@@ -1094,29 +1170,9 @@ const
  {$I sysucode.inc}
 {$ENDIF OS2UNICODE}
 
-{*var}
-{* ST: pointer;}
-{*}
 begin
 {$IFDEF OS2EXCEPTIONS}
-(*    asm
-      { allocate space for exception registration record }
-     pushl $0
-     pushl $0}
-{*     pushl %fs:(0)}
-        { movl  %esp,%fs:(0)
-          but don't insert it as it doesn't
-          point to anything yet
-          this will be used in signals unit }
-     movl %esp,%eax
-     movl %eax,ExcptReg
-     pushl %ebp
-     movl %esp,%eax
-{*     movl %eax,st*}
-     movl %eax,StackTop
-    end;
-{*    StackTop:=st;}
-*)    asm
+    asm
      xorl %eax,%eax
      movw %ss,%ax
      movl %eax,_SS
@@ -1166,24 +1222,28 @@ begin
        from the high memory region before changing value of this variable. *)
     InitHeap;
 
-    if DosQueryModuleHandle (@DosCallsName [0], DosCallsHandle) = 0 then
-      begin
-        if DosQueryProcAddr (DosCallsHandle, OrdDosOpenL, nil, P) = 0 then
-          begin
-            Sys_DosOpenL := TDosOpenL (P);
-            if DosQueryProcAddr (DosCallsHandle, OrdDosSetFilePtrL, nil, P) = 0
-                                                                           then
-              begin
-                Sys_DosSetFilePtrL := TDosSetFilePtrL (P);
-                if DosQueryProcAddr (DosCallsHandle, OrdDosSetFileSizeL, nil,
-                                                                    P) = 0 then
-                  begin
-                    Sys_DosSetFileSizeL := TDosSetFileSizeL (P);
-                    FSApi64 := true;
-                  end;
-              end;
-          end;
-      end;
+    RC := DosQueryModuleHandle (@DosCallsName [0], DosCallsHandle);
+    if RC = 0 then
+     begin
+      RC := DosQueryProcAddr (DosCallsHandle, OrdDosOpenL, nil, P);
+      if RC = 0 then
+       begin
+        Sys_DosOpenL := TDosOpenL (P);
+        RC := DosQueryProcAddr (DosCallsHandle, OrdDosSetFilePtrL, nil, P);
+        if RC = 0 then
+         begin
+          Sys_DosSetFilePtrL := TDosSetFilePtrL (P);
+          RC := DosQueryProcAddr (DosCallsHandle, OrdDosSetFileSizeL, nil, P);
+          if RC = 0 then
+           begin
+            Sys_DosSetFileSizeL := TDosSetFileSizeL (P);
+            FSApi64 := true;
+           end;
+         end;
+       end;
+     end;
+    if RC <> 0 then
+     OSErrorWatch (RC);
 
     { ... and exceptions }
     SysInitExceptions;
@@ -1220,4 +1280,15 @@ begin
   WriteLn (StdErr, 'Old exception ', HexStr (OldExceptAddr, 8),
    ', new exception ', HexStr (NewExceptAddr, 8), ', _SS = ', HexStr (_SS, 8));
 {$endif SYSTEMEXCEPTIONDEBUG}
+
+  RC := DosQueryCP (SizeOf (CPArr), @CPArr, ReturnedSize);
+  if RC <> 0 then
+   OSErrorWatch (RC)
+  else if (ReturnedSize >= 4) then
+   begin
+    DefaultSystemCodePage := CPArr [0];
+    DefaultRTLFileSystemCodePage := DefaultSystemCodePage;
+    DefaultFileSystemCodePage := DefaultSystemCodePage;
+    DefaultUnicodeCodePage := CP_UTF16;
+   end;
 end.

rtl/os2/systhrd.inc

@@ -195,15 +195,21 @@ end;
 
 
 procedure SysAllocateThreadVars;
+var
+ RC: cardinal;
 begin
  { we've to allocate the memory from the OS }
  { because the FPC heap management uses     }
  { exceptions which use threadvars but      }
  { these aren't allocated yet ...           }
  { allocate room on the heap for the thread vars }
- if DosAllocMem (DataIndex^, ThreadVarBlockSize, pag_Read or pag_Write
-                                                       or pag_Commit) <> 0 then
-  HandleError (8);
+ RC := DosAllocMem (DataIndex^, ThreadVarBlockSize, pag_Read or pag_Write
+                                                       or pag_Commit);
+ if RC <> 0 then
+  begin
+   OSErrorWatch (RC);
+   HandleError (8);
+  end;
 { The Windows API apparently provides a way to fill the allocated memory with }
 { zeros; we probably need to do it ourselves for compatibility. }
  FillChar (DataIndex^^, 0, ThreadVarBlockSize);
@@ -240,12 +246,16 @@ end;
 
 
 procedure SysFiniMultithreading;
+var
+ RC: cardinal;
 begin
   if IsMultiThread then
    begin
-    if DosFreeThreadLocalMemory (DataIndex) <> 0 then
+    RC := DosFreeThreadLocalMemory (DataIndex);
+    if RC <> 0 then
      begin
 {??? What to do if releasing fails?}
+      OSErrorWatch (RC);
      end;
     DataIndex := nil;
    end;
@@ -253,9 +263,13 @@ end;
 
 
 procedure SysReleaseThreadVars;
+var
+ RC: cardinal;
 begin
-  DosFreeMem (DataIndex^);
-  DataIndex^ := nil;
+ RC := DosFreeMem (DataIndex^);
+ if RC <> 0 then
+  OSErrorWatch (RC);
+ DataIndex^ := nil;
 end;
 
 
@@ -334,6 +348,7 @@ function SysBeginThread (SA: pointer; StackSize : PtrUInt;
                          CreationFlags: cardinal; var ThreadId: TThreadID): DWord;
 var
   TI: PThreadInfo;
+  RC: cardinal;
 begin
 { WriteLn is not a good idea before thread initialization...
   $ifdef DEBUG_MT
@@ -351,8 +366,9 @@ begin
 {$ifdef DEBUG_MT}
   WriteLn ('Starting new thread');
 {$endif DEBUG_MT}
-  if DosCreateThread (cardinal (ThreadID), @ThreadMain, TI,
-                                             CreationFlags, StackSize) = 0 then
+  RC := DosCreateThread (cardinal (ThreadID), @ThreadMain, TI,
+                                                     CreationFlags, StackSize);
+  if RC = 0 then
    SysBeginThread := ThreadID
   else
    begin
@@ -361,6 +377,7 @@ begin
     WriteLn ('Thread creation failed');
 {$ENDIF DEBUG_MT}
     Dispose (TI);
+    OSErrorWatch (RC);
    end;
 end;
 
@@ -379,40 +396,62 @@ end;
 
 
 function SysSuspendThread (ThreadHandle: dword): dword;
+var
+  RC: cardinal;
 begin
 {$WARNING Check expected return value}
-  SysSuspendThread := DosSuspendThread (ThreadHandle);
+  RC := DosSuspendThread (ThreadHandle);
+  SysSuspendThread := RC;
+  if RC <> 0 then
+   OSErrorWatch (RC);
 end;
 
 
 function SysResumeThread (ThreadHandle: dword): dword;
+var
+  RC: cardinal;
 begin
 {$WARNING Check expected return value}
-  SysResumeThread := DosResumeThread (ThreadHandle);
+  RC := DosResumeThread (ThreadHandle);
+  SysResumeThread := RC;
+  if RC <> 0 then
+   OSErrorWatch (RC);
 end;
 
 
 function SysKillThread (ThreadHandle: dword): dword;
+var
+  RC: cardinal;
 begin
-  SysKillThread := DosKillThread (ThreadHandle);
+  RC := DosKillThread (ThreadHandle);
+  SysKillThread := RC;
+  if RC <> 0 then
+   OSErrorWatch (RC);
 end;
 
+{$PUSH}
+{$WARNINGS OFF}
 function SysCloseThread (ThreadHandle: TThreadID): dword;
 begin
 { Probably not relevant under OS/2? }
 //      SysCloseThread:=CloseHandle(threadHandle);
 end;
+{$POP}
 
 function SysWaitForThreadTerminate (ThreadHandle: dword;
                                                     TimeoutMs: longint): dword;
 var
-  RC: cardinal;
+  RC, RC2: cardinal;
 const
 { Wait at most 100 ms before next check for thread termination }
   WaitTime = 100;
 begin
   if TimeoutMs = 0 then
-   RC := DosWaitThread (ThreadHandle, dcWW_Wait)
+   begin
+    RC := DosWaitThread (ThreadHandle, dcWW_Wait);
+    if RC <> 0 then
+     OSErrorWatch (RC);
+   end
   else
    repeat
     RC := DosWaitThread (ThreadHandle, dcWW_NoWait);
@@ -423,10 +462,14 @@ begin
       else
        begin
         DosSleep (TimeoutMs);
-        DosWaitThread (ThreadHandle, dcWW_NoWait);
+        RC2 := DosWaitThread (ThreadHandle, dcWW_NoWait);
+        if RC2 <> 0 then
+         OSErrorWatch (RC2);
        end;
       Dec (TimeoutMs, WaitTime);
-     end;
+     end
+    else if RC <> 0 then
+     OSErrorWatch (RC);
    until (RC <> 294) or (TimeoutMs <= 0);
   SysWaitForThreadTerminate := RC;
 end;
@@ -451,7 +494,9 @@ begin
   else
    begin
     RC := DosQuerySysState (qs_Process, 0, ProcessID, 0, PPtrRec^, BufSize);
-    if (RC = 0) and (PPtrRec^.PProcRec <> nil)
+    if RC <> 0 then
+     OSErrorWatch (RC)
+    else if (PPtrRec^.PProcRec <> nil)
                                   and (PPtrRec^.PProcRec^.PThrdRec <> nil) then
      begin
       BufEnd := PtrUInt (PPtrRec) + BufSize;
@@ -480,6 +525,7 @@ function SysThreadSetPriority (ThreadHandle: dword; Prio: longint): boolean;
 var
   Delta: longint;
   Priority: cardinal;
+  RC: cardinal;
 begin
   Priority := GetOS2ThreadPriority (ThreadHandle);
   if Priority > High (word) then
@@ -491,8 +537,10 @@ begin
      Delta := - TPrio (Priority).PrioLevel
     else if Delta + TPrio (Priority).PrioLevel > 31 then
      Delta := 31 - TPrio (Priority).PrioLevel;
-    SysThreadSetPriority :=
-               DosSetPriority (dpThread, dpSameClass, Delta, ThreadHandle) = 0;
+    RC := DosSetPriority (dpThread, dpSameClass, Delta, ThreadHandle);
+    if RC <> 0 then
+     OSErrorWatch (RC);
+    SysThreadSetPriority := RC = 0;
    end;
 end;
 
@@ -529,25 +577,43 @@ end;
 *****************************************************************************}
 
 procedure SysInitCriticalSection (var CS);
+var
+  RC: cardinal;
 begin
-  if DosCreateMutExSem (nil, THandle (CS), 0, 0) <> 0 then
-   FPC_ThreadError;
+  RC := DosCreateMutExSem (nil, THandle (CS), 0, 0);
+  if RC <> 0 then
+   begin
+    OSErrorWatch (RC);
+    FPC_ThreadError;
+   end;
 end;
 
 procedure SysDoneCriticalSection (var CS);
+var
+  RC: cardinal;
 begin
 (* Trying to release first since this might apparently be the expected  *)
 (* behaviour in Delphi according to comment in the Unix implementation. *)
   repeat
   until DosReleaseMutExSem (THandle (CS)) <> 0;
-  if DosCloseMutExSem (THandle (CS)) <> 0 then
-   FPC_ThreadError;
+  RC := DosCloseMutExSem (THandle (CS));
+  if RC <> 0 then
+   begin
+    OSErrorWatch (RC);
+    FPC_ThreadError;
+   end;
 end;
 
 procedure SysEnterCriticalSection (var CS);
+var
+  RC: cardinal;
 begin
-  if DosRequestMutExSem (THandle (CS), cardinal (-1)) <> 0 then
-   FPC_ThreadError;
+  RC := DosRequestMutExSem (THandle (CS), cardinal (-1));
+  if RC <> 0 then
+   begin
+    OSErrorWatch (RC);
+    FPC_ThreadError;
+   end;
 end;
 
 function SysTryEnterCriticalSection (var CS): longint;
@@ -559,9 +625,15 @@ begin
 end;
 
 procedure SysLeaveCriticalSection (var CS);
+var
+  RC: cardinal;
 begin
-  if DosReleaseMutExSem (THandle (CS)) <> 0 then
-   FPC_ThreadError;
+  RC := DosReleaseMutExSem (THandle (CS));
+  if RC <> 0 then
+   begin
+    OSErrorWatch (RC);
+    FPC_ThreadError;
+   end;
 end;
 
 
@@ -607,18 +679,23 @@ begin
   if RC <> 0 then
    begin
     Dispose (PLocalEventRec (Result));
+    OSErrorWatch (RC);
     FPC_ThreadError;
    end;
 end;
 
 
 procedure SysBasicEventDestroy (State: PEventState);
+var
+  RC: cardinal;
 begin
   if State = nil then
    FPC_ThreadError
   else
    begin
-    DosCloseEventSem (PLocalEventRec (State)^.FHandle);
+    RC := DosCloseEventSem (PLocalEventRec (State)^.FHandle);
+    if RC <> 0 then
+     OSErrorWatch (RC);
     Dispose (PLocalEventRec (State));
    end;
 end;
@@ -627,22 +704,33 @@ end;
 procedure SysBasicEventResetEvent (State: PEventState);
 var
   PostCount: cardinal;
+  RC: cardinal;
 begin
   if State = nil then
    FPC_ThreadError
   else
+   begin
 (* In case of later addition of error checking:    *)
 (* RC 300 = Error_Already_Reset which would be OK. *)
-   DosResetEventSem (PLocalEventRec (State)^.FHandle, PostCount);
+    RC := DosResetEventSem (PLocalEventRec (State)^.FHandle, PostCount);
+    if (RC <> 0) and (RC <> 300) then
+     OSErrorWatch (RC);
+   end;
 end;
 
 
 procedure SysBasicEventSetEvent (State: PEventState);
+var
+  RC: cardinal;
 begin
   if State = nil then
    FPC_ThreadError
   else
-   DosPostEventSem (PLocalEventRec (State)^.FHandle);
+   begin
+    RC := DosPostEventSem (PLocalEventRec (State)^.FHandle);
+    if RC <> 0 then
+     OSErrorWatch (RC);
+   end;
 end;
 
 
@@ -661,6 +749,7 @@ begin
     else
      begin
       Result := wrError;
+      OSErrorWatch (RC);
       PLocalEventRec (State)^.FLastError := RC;
      end;
     end;
@@ -669,41 +758,64 @@ end;
 
 
 function SysRTLEventCreate: PRTLEvent;
+var
+  RC: cardinal;
 begin
   Result := PRTLEvent (-1);
-  DosCreateEventSem (nil, THandle (Result), dce_AutoReset, 0);
+  RC := DosCreateEventSem (nil, THandle (Result), dce_AutoReset, 0);
+  if RC <> 0 then
+   OSErrorWatch (RC);
 end;
 
 
 procedure SysRTLEventDestroy (AEvent: PRTLEvent);
+var
+  RC: cardinal;
 begin
-  DosCloseEventSem (THandle (AEvent));
+  RC := DosCloseEventSem (THandle (AEvent));
+  if RC <> 0 then
+   OSErrorWatch (RC);
 end;
 
 
 procedure SysRTLEventSetEvent (AEvent: PRTLEvent);
+var
+  RC: cardinal;
 begin
-  DosPostEventSem (THandle (AEvent));
+  RC := DosPostEventSem (THandle (AEvent));
+  if RC <> 0 then
+   OSErrorWatch (RC);
 end;
 
 
 procedure SysRTLEventWaitFor (AEvent: PRTLEvent);
+var
+  RC: cardinal;
 begin
-  DosWaitEventSem (THandle (AEvent), cardinal (-1));
+  RC := DosWaitEventSem (THandle (AEvent), cardinal (-1));
+  if RC <> 0 then
+   OSErrorWatch (RC);
 end;
 
 
 procedure SysRTLEventWaitForTimeout (AEvent: PRTLEvent; Timeout: longint);
+var
+  RC: cardinal;
 begin
-  DosWaitEventSem (THandle (AEvent), Timeout);
+  RC := DosWaitEventSem (THandle (AEvent), Timeout);
+  if RC <> 0 then
+   OSErrorWatch (RC);
 end;
 
 
 procedure SysRTLEventResetEvent (AEvent: PRTLEvent);
 var
   PostCount: cardinal;
+  RC: cardinal;
 begin
-  DosResetEventSem (THandle (AEvent), PostCount);
+  RC := DosResetEventSem (THandle (AEvent), PostCount);
+  if RC <> 0 then
+   OSErrorWatch (RC);
 end;
 
 
@@ -713,11 +825,15 @@ const
   svNumProcessors = 26;
 var
   ProcNum: cardinal;
+  RC: cardinal;
 begin
   GetCPUCount := 1;
-  if DosQuerySysInfo (svNumProcessors, svNumProcessors, ProcNum,
-                                                     SizeOf (ProcNum)) = 0 then
-   GetCPUCount := ProcNum;
+  RC := DosQuerySysInfo (svNumProcessors, svNumProcessors, ProcNum,
+                                                             SizeOf (ProcNum));
+  if RC = 0 then
+   GetCPUCount := ProcNum
+  else
+   OSErrorWatch (RC);
 end;
 
 

rtl/os2/sysutils.pp

@@ -23,6 +23,7 @@ interface
 {$H+}
 
 {$DEFINE HAS_SLEEP}
+{$DEFINE HAS_OSERROR}
 
 { used OS file system APIs use ansistring }
 {$define SYSUTILS_HAS_ANSISTR_FILEUTIL_IMPL}
@@ -83,8 +84,11 @@ begin
   If Rc=0 then
     FileOpen:=Handle
   else
+   begin
     FileOpen:=feInvalidHandle; //FileOpen:=-RC;
     //should return feInvalidHandle(=-1) if fail, other negative returned value are no more errors
+    OSErrorWatch (RC);
+   end;
 end;
 
 function FileCreate (const FileName: RawByteString): THandle;
@@ -115,56 +119,84 @@ begin
   if RC = 0 then
    FileCreate := Handle
   else
-   FileCreate := feInvalidHandle;
+   begin
+    FileCreate := feInvalidHandle;
+    OSErrorWatch (RC);
+   end;
 End;
 
 
 function FileRead (Handle: THandle; Out Buffer; Count: longint): longint;
 Var
   T: cardinal;
+  RC: cardinal;
 begin
-  DosRead(Handle, Buffer, Count, T);
+  RC := DosRead (Handle, Buffer, Count, T);
   FileRead := longint (T);
+  if RC <> 0 then
+   OSErrorWatch (RC);
 end;
 
 function FileWrite (Handle: THandle; const Buffer; Count: longint): longint;
 Var
   T: cardinal;
+  RC: cardinal;
 begin
-  DosWrite (Handle, Buffer, Count, T);
+  RC := DosWrite (Handle, Buffer, Count, T);
   FileWrite := longint (T);
+  if RC <> 0 then
+   OSErrorWatch (RC);
 end;
 
 function FileSeek (Handle: THandle; FOffset, Origin: longint): longint;
 var
   NPos: int64;
+  RC: cardinal;
 begin
-  if (Sys_DosSetFilePtrL (Handle, FOffset, Origin, NPos) = 0)
-                                               and (NPos < high (longint)) then
+  RC := Sys_DosSetFilePtrL (Handle, FOffset, Origin, NPos);
+  if (RC = 0) and (NPos < high (longint)) then
     FileSeek:= longint (NPos)
   else
+   begin
     FileSeek:=-1;
+    OSErrorWatch (RC);
+   end;
 end;
 
 function FileSeek (Handle: THandle; FOffset: Int64; Origin: Longint): Int64;
 var
   NPos: int64;
+  RC: cardinal;
 begin
-  if Sys_DosSetFilePtrL (Handle, FOffset, Origin, NPos) = 0 then
+  RC := Sys_DosSetFilePtrL (Handle, FOffset, Origin, NPos);
+  if RC = 0 then
     FileSeek:= NPos
   else
+   begin
     FileSeek:=-1;
+    OSErrorWatch (RC);
+   end;
 end;
 
 procedure FileClose (Handle: THandle);
+var
+  RC: cardinal;
 begin
-  DosClose(Handle);
+  RC := DosClose (Handle);
+  if RC <> 0 then
+   OSErrorWatch (RC);
 end;
 
 function FileTruncate (Handle: THandle; Size: Int64): boolean;
+var
+  RC: cardinal;
 begin
-  FileTruncate:=Sys_DosSetFileSizeL(Handle, Size)=0;
-  FileSeek(Handle, 0, 2);
+  RC := Sys_DosSetFileSizeL(Handle, Size);
+  FileTruncate := RC = 0;
+  if RC = 0 then
+   FileSeek(Handle, 0, 2)
+  else
+   OSErrorWatch (RC);
 end;
 
 function FileAge (const FileName: RawByteString): longint;
@@ -222,7 +254,9 @@ begin
   else
    Err := DosFindFirst (PChar (SystemEncodedPath), Rslt.FindHandle,
             Attr and FindResvdMask, FStat, SizeOf (FStat^), Count, ilStandard);
-  if (Err = 0) and (Count = 0) then
+  if Err <> 0 then
+   OSErrorWatch (Err)
+  else if Count = 0 then
    Err := 18;
   InternalFindFirst := -Err;
   if Err = 0 then
@@ -261,7 +295,9 @@ begin
   New (FStat);
   Count := 1;
   Err := DosFindNext (Rslt.FindHandle, FStat, SizeOf (FStat^), Count);
-  if (Err = 0) and (Count = 0) then
+  if Err <> 0 then
+   OSErrorWatch (Err)
+  else if Count = 0 then
    Err := 18;
   InternalFindNext := -Err;
   if Err = 0 then
@@ -290,9 +326,12 @@ end;
 Procedure InternalFindClose(var Handle: THandle);
 var
   SR: PSearchRec;
+  RC: cardinal;
 begin
-  DosFindClose (Handle);
+  RC := DosFindClose (Handle);
   Handle := 0;
+  if RC <> 0 then
+   OSErrorWatch (RC);
 end;
 
 function FileGetDate (Handle: THandle): longint;
@@ -308,7 +347,10 @@ begin
     if Time = 0 then
       Time := FStat.TimeCreation + longint (FStat.DateCreation) shl 16;
   end else
+   begin
     Time:=0;
+    OSErrorWatch (RC);
+   end;
   FileGetDate:=Time;
 end;
 
@@ -320,19 +362,25 @@ begin
   New (FStat);
   RC := DosQueryFileInfo (Handle, ilStandard, FStat, SizeOf (FStat^));
   if RC <> 0 then
-    FileSetDate := -1
+   begin
+    FileSetDate := -1;
+    OSErrorWatch (RC);
+   end
   else
-  begin
+   begin
     FStat^.DateLastAccess := Hi (Age);
     FStat^.DateLastWrite := Hi (Age);
     FStat^.TimeLastAccess := Lo (Age);
     FStat^.TimeLastWrite := Lo (Age);
     RC := DosSetFileInfo (Handle, ilStandard, FStat, SizeOf (FStat^));
     if RC <> 0 then
-      FileSetDate := -1
+     begin
+      FileSetDate := -1;
+      OSErrorWatch (RC);
+     end
     else
-      FileSetDate := 0;
-  end;
+     FileSetDate := 0;
+   end;
   Dispose (FStat);
 end;
 
@@ -340,11 +388,18 @@ function FileGetAttr (const FileName: RawByteString): longint;
 var
   FS: PFileStatus3;
   SystemFileName: RawByteString;
+  RC: cardinal;
 begin
   SystemFileName:=ToSingleByteFileSystemEncodedFileName(Filename);
   New(FS);
-  Result:=-DosQueryPathInfo(PChar (SystemFileName), ilStandard, FS, SizeOf(FS^));
-  If Result=0 Then Result:=FS^.attrFile;
+  RC := DosQueryPathInfo(PChar (SystemFileName), ilStandard, FS, SizeOf(FS^));
+  if RC = 0 then
+   Result := FS^.AttrFile
+  else
+   begin
+    Result := - longint (RC);
+    OSErrorWatch (RC);
+   end;
   Dispose(FS);
 end;
 
@@ -352,12 +407,16 @@ function FileSetAttr (const Filename: RawByteString; Attr: longint): longint;
 Var
   FS: PFileStatus3;
   SystemFileName: RawByteString;
+  RC: cardinal;
 Begin
   SystemFileName:=ToSingleByteFileSystemEncodedFileName(Filename);
   New(FS);
   FillChar(FS, SizeOf(FS^), 0);
   FS^.AttrFile:=Attr;
-  Result:=-DosSetPathInfo(PChar (SystemFileName), ilStandard, FS, SizeOf(FS^), 0);
+  RC := DosSetPathInfo(PChar (SystemFileName), ilStandard, FS, SizeOf(FS^), 0);
+  if RC <> 0 then
+   OSErrorWatch (RC);
+  Result := - longint (RC);
   Dispose(FS);
 end;
 
@@ -365,18 +424,34 @@ end;
 function DeleteFile (const FileName: RawByteString): boolean;
 var
   SystemFileName: RawByteString;
+  RC: cardinal;
 Begin
   SystemFileName:=ToSingleByteFileSystemEncodedFileName(Filename);
-  Result:=(DosDelete(PChar (SystemFileName))=0);
+  RC := DosDelete (PChar (SystemFileName));
+  if RC <> 0 then
+   begin
+    Result := false;
+    OSErrorWatch (RC);
+   end
+  else
+   Result := true;
 End;
 
 function RenameFile (const OldName, NewName: RawByteString): boolean;
 var
   OldSystemFileName, NewSystemFileName: RawByteString;
+  RC: cardinal;
 Begin
   OldSystemFileName:=ToSingleByteFileSystemEncodedFileName(OldName);
   NewSystemFileName:=ToSingleByteFileSystemEncodedFileName(NewName);
-  Result:=(DosMove(PChar (OldSystemFileName), PChar (NewSystemFileName))=0);
+  RC := DosMove (PChar (OldSystemFileName), PChar (NewSystemFileName));
+  if RC <> 0 then
+   begin
+    Result := false;
+    OSErrorWatch (RC);
+   end
+  else
+   Result := true;
 End;
 
 {****************************************************************************
@@ -389,13 +464,16 @@ var FI: TFSinfo;
     RC: cardinal;
 
 begin
-        {In OS/2, we use the filesystem information.}
-            RC := DosQueryFSInfo (Drive, 1, FI, SizeOf (FI));
-            if RC = 0 then
-                DiskFree := int64 (FI.Free_Clusters) *
+  {In OS/2, we use the filesystem information.}
+  RC := DosQueryFSInfo (Drive, 1, FI, SizeOf (FI));
+  if RC = 0 then
+   DiskFree := int64 (FI.Free_Clusters) *
                    int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
-            else
-                DiskFree := -1;
+  else
+   begin
+    DiskFree := -1;
+    OSErrorWatch (RC);
+   end;
 end;
 
 function DiskSize (Drive: byte): int64;
@@ -404,13 +482,16 @@ var FI: TFSinfo;
     RC: cardinal;
 
 begin
-        {In OS/2, we use the filesystem information.}
-            RC := DosQueryFSinfo (Drive, 1, FI, SizeOf (FI));
-            if RC = 0 then
-                DiskSize := int64 (FI.Total_Clusters) *
+  {In OS/2, we use the filesystem information.}
+  RC := DosQueryFSinfo (Drive, 1, FI, SizeOf (FI));
+  if RC = 0 then
+   DiskSize := int64 (FI.Total_Clusters) *
                    int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
-            else
-                DiskSize := -1;
+  else
+   begin
+    DiskSize := -1;
+    OSErrorWatch (RC);
+   end;
 end;
 
 
@@ -469,17 +550,21 @@ end;
 procedure sysbeep;
 
 begin
-  // Maybe implement later on ?
-
+  DosBeep (800, 250);
 end;
 
 {****************************************************************************
                               Locale Functions
 ****************************************************************************}
 
+var
+  Country: TCountryCode;
+  CtryInfo: TCountryInfo;
+
 procedure InitAnsi;
-var I: byte;
-    Country: TCountryCode;
+var
+  I: byte;
+  RC: cardinal;
 begin
     for I := 0 to 255 do
         UpperCaseTable [I] := Chr (I);
@@ -493,46 +578,63 @@ end;
 
 
 procedure InitInternational;
-var Country: TCountryCode;
-    CtryInfo: TCountryInfo;
-    Size: cardinal;
-    RC: cardinal;
+var
+  Size: cardinal;
+  RC: cardinal;
 begin
-    Size := 0;
-    FillChar (Country, SizeOf (Country), 0);
-    FillChar (CtryInfo, SizeOf (CtryInfo), 0);
-    RC := DosQueryCtryInfo (SizeOf (CtryInfo), Country, CtryInfo, Size);
-    if RC = 0 then
-        begin
-            DateSeparator := CtryInfo.DateSeparator;
-            case CtryInfo.DateFormat of
-             1: begin
-                    ShortDateFormat := 'd/m/y';
-                    LongDateFormat := 'dd" "mmmm" "yyyy';
-                end;
-             2: begin
-                    ShortDateFormat := 'y/m/d';
-                    LongDateFormat := 'yyyy" "mmmm" "dd';
-                end;
-             3: begin
-                    ShortDateFormat := 'm/d/y';
-                    LongDateFormat := 'mmmm" "dd" "yyyy';
-                end;
-            end;
-            TimeSeparator := CtryInfo.TimeSeparator;
-            DecimalSeparator := CtryInfo.DecimalSeparator;
-            ThousandSeparator := CtryInfo.ThousandSeparator;
-            CurrencyFormat := CtryInfo.CurrencyFormat;
-            CurrencyString := PChar (CtryInfo.CurrencyUnit);
+  Size := 0;
+  FillChar (Country, SizeOf (Country), 0);
+  FillChar (CtryInfo, SizeOf (CtryInfo), 0);
+  RC := DosQueryCtryInfo (SizeOf (CtryInfo), Country, CtryInfo, Size);
+  if RC = 0 then
+   begin
+    DateSeparator := CtryInfo.DateSeparator;
+    case CtryInfo.DateFormat of
+     1: begin
+         ShortDateFormat := 'd/m/y';
+         LongDateFormat := 'dd" "mmmm" "yyyy';
+        end;
+     2: begin
+         ShortDateFormat := 'y/m/d';
+         LongDateFormat := 'yyyy" "mmmm" "dd';
         end;
-    InitAnsi;
-    InitInternationalGeneric;
+     3: begin
+         ShortDateFormat := 'm/d/y';
+         LongDateFormat := 'mmmm" "dd" "yyyy';
+        end;
+    end;
+    TimeSeparator := CtryInfo.TimeSeparator;
+    DecimalSeparator := CtryInfo.DecimalSeparator;
+    ThousandSeparator := CtryInfo.ThousandSeparator;
+    CurrencyFormat := CtryInfo.CurrencyFormat;
+    CurrencyString := PChar (CtryInfo.CurrencyUnit);
+   end
+  else
+   OSErrorWatch (RC);
+  InitAnsi;
+  InitInternationalGeneric;
 end;
 
 function SysErrorMessage(ErrorCode: Integer): String;
-
+const
+  SysMsgFile: array [0..10] of char = 'OSO001.MSG'#0;
+var
+  OutBuf: array [0..999] of char;
+  RetMsgSize: cardinal;
+  RC: cardinal;
 begin
-  Result:=Format(SUnknownErrorCode,[ErrorCode]);
+  RC := DosGetMessage (nil, 0, @OutBuf [0], SizeOf (OutBuf),
+                                       ErrorCode, @SysMsgFile [0], RetMsgSize);
+  if RC = 0 then
+   begin
+    SetLength (Result, RetMsgSize);
+    Move (OutBuf [0], Result [1], RetMsgSize);
+   end
+  else
+   begin
+    Result:=Format(SUnknownErrorCode,[ErrorCode]);
+    OSErrorWatch (RC);
+   end;
 end;
 
 
@@ -687,7 +789,10 @@ begin
  SD.ObjectBuffLen := ObjBufSize;
  RC := DosCreateQueue (HQ, quFIFO or quConvert_Address, @QName [1]);
  if RC <> 0 then
-  Move (QName [1], ObjNameBuf^, Length (QName))
+  begin
+   Move (QName [1], ObjNameBuf^, Length (QName));
+   OSErrorWatch (RC);
+  end
  else
   begin
    RC := DosStartSession (SD, SID, PID);
@@ -697,15 +802,28 @@ begin
      if RC = 0 then
       begin
        Result := PCI^.Return;
-       DosCloseQueue (HQ);
-       DosFreeMem (PCI);
+       RC := DosCloseQueue (HQ);
+       if RC <> 0 then
+        OSErrorWatch (RC);
+       RC := DosFreeMem (PCI);
+       if RC <> 0 then
+        OSErrorWatch (RC);
        FreeMem (ObjNameBuf, ObjBufSize);
       end
      else
-      DosCloseQueue (HQ);
+      begin
+       OSErrorWatch (RC);
+       RC := DosCloseQueue (HQ);
+       OSErrorWatch (RC);
+      end;
     end
    else
-    DosCloseQueue (HQ);
+    begin
+     OSErrorWatch (RC);
+     RC := DosCloseQueue (HQ);
+     if RC <> 0 then
+      OSErrorWatch (RC);
+    end;
   end;
 end;
 
@@ -715,52 +833,57 @@ begin
  GetMem (ObjNameBuf, ObjBufSize);
  FillChar (ObjNameBuf^, ObjBufSize, 0);
 
- if (DosQueryAppType (PChar (Path), ExecAppType) = 0) and
-                               (ApplicationType and 3 = ExecAppType and 3) then
-(* DosExecPgm should work... *)
+ RC := DosQueryAppType (PChar (Path), ExecAppType);
+ if RC <> 0 then
   begin
-   if ComLine = '' then
-    begin
-     Args0 := nil;
-     Args := nil;
-    end
-   else
+   OSErrorWatch (RC);
+   if (RC = 190) or (RC = 191) then
+    Result := StartSession;
+  end
+ else
+  begin
+   if (ApplicationType and 3 = ExecAppType and 3) then
+(* DosExecPgm should work... *)
     begin
-     GetMem (Args0, MaxArgsSize);
-     Args := Args0;
+     if ComLine = '' then
+      begin
+       Args0 := nil;
+       Args := nil;
+      end
+     else
+      begin
+       GetMem (Args0, MaxArgsSize);
+       Args := Args0;
 (* Work around a bug in OS/2 - argument to DosExecPgm *)
 (* should not cross 64K boundary. *)
-     if ((PtrUInt (Args) + 1024) and $FFFF) < 1024 then
-      Inc (pointer (Args), 1024);
-     ArgSize := 0;
-     Move (Path [1], Args^ [ArgSize], Length (Path));
-     Inc (ArgSize, Length (Path));
-     Args^ [ArgSize] := 0;
-     Inc (ArgSize);
-     {Now do the real arguments.}
-     Move (ComLine [1], Args^ [ArgSize], Length (ComLine));
-     Inc (ArgSize, Length (ComLine));
-     Args^ [ArgSize] := 0;
-     Inc (ArgSize);
-     Args^ [ArgSize] := 0;
-    end;
-   Res.ExitCode := $FFFFFFFF;
-   RC := DosExecPgm (ObjNameBuf, ObjBufSize, 0, Args, nil, Res, PChar (Path));
-   if Args0 <> nil then
-    FreeMem (Args0, MaxArgsSize);
-   if RC = 0 then
-    begin
-     Result := Res.ExitCode;
-     FreeMem (ObjNameBuf, ObjBufSize);
+       if ((PtrUInt (Args) + 1024) and $FFFF) < 1024 then
+        Inc (pointer (Args), 1024);
+       ArgSize := 0;
+       Move (Path [1], Args^ [ArgSize], Length (Path));
+       Inc (ArgSize, Length (Path));
+       Args^ [ArgSize] := 0;
+       Inc (ArgSize);
+       {Now do the real arguments.}
+       Move (ComLine [1], Args^ [ArgSize], Length (ComLine));
+       Inc (ArgSize, Length (ComLine));
+       Args^ [ArgSize] := 0;
+       Inc (ArgSize);
+       Args^ [ArgSize] := 0;
+      end;
+     Res.ExitCode := $FFFFFFFF;
+     RC := DosExecPgm (ObjNameBuf, ObjBufSize, 0, Args, nil, Res,
+                                                                 PChar (Path));
+     if RC <> 0 then
+      OSErrorWatch (RC);
+     if Args0 <> nil then
+      FreeMem (Args0, MaxArgsSize);
+     if RC = 0 then
+      begin
+       Result := Res.ExitCode;
+       FreeMem (ObjNameBuf, ObjBufSize);
+      end
     end
-   else
-    begin
-     if (RC = 190) or (RC = 191) then
-      Result := StartSession;
-    end;
-  end
- else
-  Result := StartSession;
+  end;
  if RC <> 0 then
   begin
    ObjName := StrPas (ObjNameBuf);
@@ -805,16 +928,33 @@ begin
   GetTickCount := L;
 end;
 
-
 function GetTickCount64: QWord;
 var
-  L: cardinal;
+  Freq2: cardinal;
+  T: QWord;
 begin
-  DosQuerySysInfo (svMsCount, svMsCount, L, 4);
-  GetTickCount64 := L;
+  DosTmrQueryFreq (Freq2);
+  DosTmrQueryTime (T);
+  GetTickCount64 := T div (QWord (Freq2) div 1000);
+{$NOTE GetTickCount64 takes 20 microseconds on 1GHz CPU, GetTickCount not measurable}
 end;
 
+threadvar
+  LastOSError: cardinal;
 
+const
+  OrigOSErrorWatch: TOSErrorWatch = nil;
+
+procedure TrackLastOSError (Error: cardinal);
+begin
+  LastOSError := Error;
+  OrigOSErrorWatch (Error);
+end;
+
+function GetLastOSError: Integer;
+begin
+  GetLastOSError := Integer (LastOSError);
+end;
 
 {****************************************************************************
                               Initialization code
@@ -824,6 +964,9 @@ Initialization
   InitExceptions;       { Initialize exceptions. OS independent }
   InitInternational;    { Initialize internationalization settings }
   OnBeep:=@SysBeep;
+  LastOSError := 0;
+  OrigOSErrorWatch := OSErrorWatch;
+  SetOSErrorTracking (@TrackLastOSError);
 Finalization
   DoneExceptions;
 end.

rtl/os2/tthread.inc

@@ -166,13 +166,16 @@ procedure TThread.SetPriority(Value: TThreadPriority);
 var
  PTIB: PThreadInfoBlock;
  PPIB: PProcessInfoBlock;
+ RC: cardinal;
 begin
  DosGetInfoBlocks (@PTIB, @PPIB);
 (*
  PTIB^.TIB2^.Priority := Priorities [Value];
 *)
- DosSetPriority (2, High (Priorities [Value]),
+ RC := DosSetPriority (2, High (Priorities [Value]),
                      Low (Priorities [Value]) - PTIB^.TIB2^.Priority, FHandle);
+ if RC <> 0 then
+  OSErrorWatch (RC);
 end;
 
 
@@ -213,9 +216,13 @@ end;
 function TThread.WaitFor: Integer;
 var
  FH: cardinal;
+ RC: cardinal;
 begin
  if GetCurrentThreadID = MainThreadID then
   while not (FFinished) do
    CheckSynchronize (1000);
- WaitFor := DosWaitThread (FH, dtWait);
+ RC := DosWaitThread (FH, dtWait);
+ if RC <> 0 then
+  OSErrorWatch (RC);
+ WaitFor := RC;
 end;