* merging Carl's fixes from the fixes branch

rtl/os2/doscalls.pas

@@ -1600,7 +1600,7 @@ function DosQueryMuxWaitSem(Handle:longint;var CSemRec:longint;
 ****************************************************************************}
 
 
-type    TDateTime=record
+type    TDateTime=packed record
             Hour,
             Minute,
             Second,
@@ -1608,7 +1608,7 @@ type    TDateTime=record
             Day,
             Month:byte;
             Year:word;
-            TimeZone:integer;
+            TimeZone:smallint;
             WeekDay:byte;
         end;
         PDateTime=^TDateTime;
@@ -4031,7 +4031,10 @@ external 'DOSCALLS' index 582;
 end.
 {
   $Log$
-  Revision 1.9  2001-01-27 18:31:38  hajny
+  Revision 1.10  2001-05-20 18:40:32  hajny
+    * merging Carl's fixes from the fixes branch
+
+  Revision 1.9  2001/01/27 18:31:38  hajny
     * Another bunch of compatibility additions
 
   Revision 1.8  2001/01/23 20:28:05  hajny

rtl/os2/pmwin.pas

@@ -1993,7 +1993,7 @@ const
     function WinInitialize(flOptions : cardinal) : cardinal; cdecl;external 'pmwin' index 763;
     function WinTerminate(hab : cardinal) : longbool; cdecl;external 'pmwin' index 888;
     function WinQueryAnchorBlock(hwnd : cardinal) : cardinal; cdecl;external 'pmwin' index 800;
-    function WinCreateWindow(hwndParent : cardinal;pszClass,pszName : pchar;flStyle : cardinal;x,y,cx,cy : longint;hwndOwner,hwndInsertBehind,id : cardinal;var pCtlData,PresParams : pointer) : cardinal; cdecl;external 'pmwin' index 909;
+    function WinCreateWindow(hwndParent : cardinal;pszClass,pszName : pchar;flStyle : cardinal;x,y,cx,cy : longint;hwndOwner,hwndInsertBehind,id : cardinal;var pCtlData,pPresParams : pointer) : cardinal; cdecl;external 'pmwin' index 909;
     function WinEnableWindow(hwnd : cardinal;fEnable : longbool) : longbool; cdecl;external 'pmwin' index 735;
     function WinIsWindowEnabled(hwnd : cardinal) : longbool; cdecl;external 'pmwin' index 773;
     function WinEnableWindowUpdate(hwnd : cardinal;fEnable : longbool) : longbool; cdecl;external 'pmwin' index 736;
@@ -2150,7 +2150,7 @@ const
     function WinCopyRect(hab : cardinal;var rclDst,rclSrc : TRectl) : longbool; cdecl;external 'pmwin' index 710;
     function WinCopyRect(hab : cardinal;prclDst,prclSrc : PRectl) : longbool; cdecl;external 'pmwin' index 710;
     function WinSetRect(hab : cardinal;var rcl : TRectl;xLeft,yBottom,xRight,yTop : longint) : longbool; cdecl;external 'pmwin' index 868;
-    function WinSetRect(hab : cardinal;prcl : PRectl;xLeft,yBottom,xRight,yTop : longint) : longbool; cdecl;external 'pmwin' index 868;
+    function WinSetRect(hab : cardinal;_prcl : PRectl;xLeft,yBottom,xRight,yTop : longint) : longbool; cdecl;external 'pmwin' index 868;
     function WinIsRectEmpty(hab : cardinal;var rcl : TRectl) : longbool; cdecl;external 'pmwin' index 770;
     function WinIsRectEmpty(hab : cardinal;prcl : PRectl) : longbool; cdecl;external 'pmwin' index 770;
     function WinEqualRect(hab : cardinal;var rcl1,rcl2 : TRectl) : longbool; cdecl;external 'pmwin' index 741;
@@ -2169,7 +2169,7 @@ const
     function WinUnionRect(hab : cardinal;prclDst,prclSrc1,prclSrc2 : PRectl) : longbool; cdecl;external 'pmwin' index 891;
     function WinSubtractRect(hab : cardinal;var rclDst,rclSrc1,rclSrc2 : TRectl) : longbool; cdecl;external 'pmwin' index 887;
     function WinSubtractRect(hab : cardinal;prclDst,prclSrc1,prclSrc2 : PRectl) : longbool; cdecl;external 'pmwin' index 887;
-    function WinMakeRect(hab : cardinal;var pwrc : TRectl) : longbool; cdecl;external 'pmwin' index 786;
+    function WinMakeRect(hab : cardinal;var wrc : TRectl) : longbool; cdecl;external 'pmwin' index 786;
     function WinMakeRect(hab : cardinal;pwrc : PRectl) : longbool; cdecl;external 'pmwin' index 786;
     function WinMakePoints(hab : cardinal;var wpt : TPointL;cwpt : cardinal) : longbool; cdecl;external 'pmwin' index 785;
     function WinMakePoints(hab : cardinal;pwpt : PPointL;cwpt : cardinal) : longbool; cdecl;external 'pmwin' index 785;
@@ -2265,7 +2265,7 @@ const
     function WinGetErrorInfo(hab : cardinal) : PERRINFO; cdecl;external 'pmwin' index 751;
     function WinFreeErrorInfo(var perrinfo : ERRINFO) : longbool; cdecl;external 'pmwin' index 748;
     function WinDdeInitiate(hwndClient : cardinal;pszAppName,pszTopicName : pchar;var cctxt : TConvContext) : longbool; cdecl;external 'pmwin' index 718;
-    function WinDdeInitiate(hwndClient : cardinal;pszAppName,pszTopicName : pchar;cctxt : PConvContext) : longbool; cdecl;external 'pmwin' index 718;
+    function WinDdeInitiate(hwndClient : cardinal;pszAppName,pszTopicName : pchar;pcctxt : PConvContext) : longbool; cdecl;external 'pmwin' index 718;
     function WinDdeRespond(hwndClient,hwndServer : cardinal;pszAppName,pszTopicName : pchar;var cctxt : TConvContext) : pointer; cdecl;external 'pmwin' index 720;
     function WinDdeRespond(hwndClient,hwndServer : cardinal;pszAppName,pszTopicName : pchar;pcctxt : PConvContext) : pointer; cdecl;external 'pmwin' index 720;
     function WinDdePostMsg(hwndTo,hwndFrom,wm : cardinal;var ddest : DDEStruct;flOptions : cardinal) : longbool; cdecl;external 'pmwin' index 719;
@@ -2970,7 +2970,10 @@ const
 end.
 {
   $Log$
-  Revision 1.3  2000-09-03 19:01:14  hajny
+  Revision 1.4  2001-05-20 18:40:34  hajny
+    * merging Carl's fixes from the fixes branch
+
+  Revision 1.3  2000/09/03 19:01:14  hajny
     + pmerr merged into PMWin
 
   Revision 1.1.2.1  2000/09/03 18:23:12  hajny

rtl/os2/prt0.as

@@ -1,5 +1,5 @@
-/ prt0.s (emx+fpk) -- Made from crt0.s,
+/ prt0.s (emx+fpc) -- Made from crt0.s,
-/                     Copyright (c) 1990-1999-2000 by Eberhard Mattes.
+/                     Copyright (c) 1990-1999-2001 by Eberhard Mattes.
 /                     Changed for Free Pascal in 1997 Daniel Mantione.
 /                     This code is _not_ under the Library GNU Public
 /                     License, because the original is not. See copying.emx
@@ -71,3 +71,4 @@ __heap_brk:
         .stabs  "___DTOR_LIST__", 21, 0, 0, 0xffffffff
         .stabs  "___crtinit1__", 21, 0, 0, 0xffffffff
         .stabs  "___crtexit1__", 21, 0, 0, 0xffffffff
+        .stabs  "___eh_frame__", 21, 0, 0, 0xffffffff

rtl/os2/system.pas

@@ -159,9 +159,43 @@ external 'DOSCALLS' index 255;
 function DosSetDefaultDisk (DiskNum:longint): longint; cdecl;
 external 'DOSCALLS' index 220;
 
+{ This is not real prototype, but its close enough  }
+{ for us. (The 2nd parameter is acutally a pointer) }
+{ to a structure.                                   }
+function DosCreateDir( Name : pchar; p : pointer): longint; cdecl;
+external 'DOSCALLS' index 270;
+
+function DosDeleteDir( Name : pchar) : longint; cdecl;
+external 'DOSCALLS' index 226;
+
 {This is the correct way to call external assembler procedures.}
 procedure syscall; external name '___SYSCALL';
 
+
+
+   { converts an OS/2 error code to a TP compatible error }
+   { code. Same thing exists under most other supported   }
+   { systems.                                             }
+   { Only call for OS/2 DLL imported routines             }
+   Procedure Errno2InOutRes;
+   Begin
+     { errors 1..18 are the same as in DOS }
+     case InOutRes of
+      { simple offset to convert these error codes }
+      { exactly like the error codes in Win32      }
+      19..31 : InOutRes := InOutRes + 131;
+      { gets a bit more complicated ... }
+      32..33 : InOutRes := 5;
+      38 : InOutRes := 100;
+      39 : InOutRes := 101;
+      112 : InOutRes := 101;
+      110 : InOutRes := 5;
+      114 : InOutRes := 6;
+      290 : InOutRes := 290;
+     end;
+     { all other cases ... we keep the same error code }
+   end;
+
 {***************************************************************************
 
                 Runtime error checking related routines.
@@ -169,6 +203,23 @@ procedure syscall; external name '___SYSCALL';
 ***************************************************************************}
 
 {$S-}
+procedure st1(stack_size : longint); [public,alias : 'FPC_STACKCHECK'];
+var
+ c: cardinal;
+begin
+ c := cardinal(Sptr) - cardinal(stack_size) - 16384;
+ if os_mode = osos2 then
+   begin
+     if (c <= cardinal(StackBottom)) then
+        HandleError(202);
+   end
+ else
+   begin
+     if (c <= cardinal(heap_brk)) then
+        HandleError(202);
+   end;
+end;
+(*
 procedure st1(stack_size:longint); assembler; [public,alias: 'FPC_STACKCHECK'];
 { called when trying to get local stack }
 { if the compiler directive $S is set   }
@@ -198,6 +249,7 @@ asm
     call HandleError
 end ['EAX','EBX'];
 {no stack check in system }
+*)
 
 {****************************************************************************
 
@@ -222,26 +274,33 @@ asm
     decl %eax
 end ['EAX'];
 
-function paramstr(l:longint):string;
-
     function args:pointer;assembler;
 
     asm
         movl argv,%eax
     end ['EAX'];
 
+
+function paramstr(l:longint):string;
+
 var p:^Pchar;
 
 begin
+    { There seems to be a problem with EMX for DOS when trying to }
+    { access paramstr(0), and to avoid problems between DOS and   }
+    { OS/2 they have been separated.                              }
+    if os_Mode = OsOs2 then
+    begin
     if L = 0 then
         begin
             GetMem (P, 260);
+            p[0] := #0;  { in case of error, initialize to empty string }
 {$ASMMODE INTEL}
             asm
                 mov edx, P
                 mov ecx, 260
                 mov eax, 7F33h
-                call syscall
+                call syscall    { error handle already with empty string }
             end;
             ParamStr := StrPas (PChar (P));
             FreeMem (P, 260);
@@ -253,23 +312,14 @@ begin
                 paramstr:=strpas(p[l]);
             end
         else paramstr:='';
-end;
+    end
-
+   else
-{
+    begin
-procedure randomize;
+      p:=args;
-
+      paramstr:=strpas(p[l]);
-var hl:longint;
-
-begin
-    asm
-        movb $0x2c,%ah
-        call syscall
-        movw %cx,-4(%ebp)
-        movw %dx,-2(%ebp)
     end;
-    randseed:=hl;
 end;
-}
+
 
 procedure randomize; assembler;
 asm
@@ -295,7 +345,7 @@ function sbrk(size:longint):longint; assembler;
 asm
     movl size,%edx
     movw $0x7f00,%ax
-    call syscall
+    call syscall     { result directly in EAX }
 end;
 
 function getheapstart:pointer;assembler;
@@ -333,12 +383,15 @@ procedure do_close(h:longint);
 begin
 { Only three standard handles under real OS/2 }
   if (h > 4) or
-     (os_MODE = osOS2) and (h > 2) then
+     ((os_MODE = osOS2) and (h > 2)) then
    begin
      asm
         movb $0x3e,%ah
         movl h,%ebx
         call syscall
+        jnc  .Lnoerror           { error code?            }
+        movw  %ax, InOutRes       { yes, then set InOutRes }
+     .Lnoerror:
      end;
    end;
 end;
@@ -388,6 +441,9 @@ end;
 
 function do_write(h,addr,len:longint) : longint; assembler;
 asm
+    xorl %eax,%eax
+    cmpl $0,len    { 0 bytes to write is undefined behavior }
+    jz   .LDOSWRITE1
     movl len,%ecx
     movl addr,%edx
     movl h,%ebx
@@ -445,26 +501,14 @@ end;
 
 procedure do_truncate(handle,pos:longint); assembler;
 asm
-(* DOS function 40h isn't safe for this according to EMX documentation
+(* DOS function 40h isn't safe for this according to EMX documentation *)
-        movl $0x4200,%eax
-        movl handle,%ebx
-        movl pos,%edx
-        call syscall
-        jc .LTruncate1
-        movl handle,%ebx
-        movl pos,%edx
-        movl %ebp,%edx
-        xorl %ecx,%ecx
-        movb $0x40,%ah
-        call syscall
-*)
     movl $0x7F25,%eax
     movl Handle,%ebx
     movl Pos,%edx
     call syscall
-    inc %eax
+    incl %eax
     movl %ecx, %eax
-    jnz .LTruncate1
+    jnz .LTruncate1      { compare the value of EAX to verify error }
 (* File position is undefined after truncation, move to the end. *)
     movl $0x4202,%eax
     movl Handle,%ebx
@@ -588,8 +632,8 @@ begin
         movw %cx, InOutRes
         movw UnusedHandle, %ax
 .LOPEN1:
-        movl f,%edx
+        movl f,%edx         { Warning : This assumes Handle is first }
-        movw %ax,(%edx)
+        movw %ax,(%edx)     { field of FileRec                       }
     end;
     if (InOutRes = 4) and Increase_File_Handle_Count then
 (* Trying again after increasing amount of file handles *)
@@ -633,9 +677,9 @@ asm
     call syscall
     mov eax, 1
     jc @IsDevEnd
-    test edx, 80h
+    test edx, 80h           { verify if it is a file  }
     jnz @IsDevEnd
-    dec eax
+    dec eax                 { nope, so result is zero }
 @IsDevEnd:
 end;
 {$ASMMODE ATT}
@@ -671,6 +715,7 @@ end;
                            Directory Handling
 *****************************************************************************}
 
+
 procedure dosdir(func:byte;const s:string);
 
 var buffer:array[0..255] of char;
@@ -690,26 +735,66 @@ begin
 end;
 
 
-procedure MkDir (const S: string);
+procedure MkDir (const S: string);[IOCHECK];
+
+var buffer:array[0..255] of char;
+    Rc : word;
 
 begin
   If (s='') or (InOutRes <> 0) then
    exit;
+ if os_mode = osOs2 then
+    begin
+      move(s[1],buffer,length(s));
+      buffer[length(s)]:=#0;
+      allowslash(Pchar(@buffer));
+      Rc := DosCreateDir(buffer,nil);
+      if Rc <> 0 then
+       begin
+         InOutRes := Rc;
+         Errno2Inoutres;
+       end;
+    end
+  else
+   begin
+     { Under EMX 0.9d DOS this routine call may sometimes fail   }
+     { The syscall documentation indicates clearly that this     }
+     { routine was NOT tested.                                   }
         DosDir ($39, S);
 end;
+end;
 
 
-procedure rmdir(const s : string);
+procedure rmdir(const s : string);[IOCHECK];
-
+var buffer:array[0..255] of char;
+    Rc : word;
 begin
   If (s='') or (InOutRes <> 0) then
    exit;
+  if os_mode = osOs2 then
+    begin
+      move(s[1],buffer,length(s));
+      buffer[length(s)]:=#0;
+      allowslash(Pchar(@buffer));
+      Rc := DosDeleteDir(buffer);
+      if Rc <> 0 then
+       begin
+         InOutRes := Rc;
+         Errno2Inoutres;
+       end;
+    end
+  else
+   begin
+     { Under EMX 0.9d DOS this routine call may sometimes fail   }
+     { The syscall documentation indicates clearly that this     }
+     { routine was NOT tested.                                   }
         DosDir ($3A, S);
 end;
+end;
 
 {$ASMMODE INTEL}
 
-procedure ChDir (const S: string);
+procedure ChDir (const S: string);[IOCheck];
 
 var RC: longint;
     Buffer: array [0..255] of char;
@@ -735,7 +820,10 @@ begin
                                         AllowSlash (PChar (@Buffer));
                                         RC := DosSetCurrentDir (@Buffer);
                                         if RC <> 0 then
+                                         begin
                                             InOutRes := RC;
+                                            Errno2InOutRes;
+                                         end;
                                     end;
                         end
                     else
@@ -745,7 +833,10 @@ begin
                             AllowSlash (PChar (@Buffer));
                             RC := DosSetCurrentDir (@Buffer);
                             if RC <> 0 then
-                                InOutRes := RC;
+                             begin
+                                  InOutRes:= RC;
+                                  Errno2InOutRes;
+                             end;
                         end;
                 end
             else
@@ -767,9 +858,13 @@ begin
 @LCHDIR:
                         end;
                         if (Length (S) > 2) and (InOutRes <> 0) then
+                            { Under EMX 0.9d DOS this routine may sometime }
+                            { fail or crash the system.                    }
                             DosDir ($3B, S);
                     end
                 else
+                    { Under EMX 0.9d DOS this routine may sometime }
+                    { fail or crash the system.                    }
                     DosDir ($3B, S);
 end;
 
@@ -894,7 +989,9 @@ begin
         call HandleError
     @heapok:
     end;
-
+    { in OS/2 this will always be nil, but in DOS mode }
+    { this can be changed.                             }
+    first_meg := nil;
     {Now request, if we are running under DOS,
      read-access to the first meg. of memory.}
     if os_mode in [osDOS,osDPMI] then
@@ -904,11 +1001,12 @@ begin
             mov ecx, 0FFFh
             xor edx, edx
             call syscall
+            jnc  @endmem
             mov first_meg, eax
+         @endmem:
         end
     else
         begin
-            first_meg := nil;
     (* Initialize the amount of file handles *)
             FileHandleCount := GetFileHandleCount;
         end;
@@ -920,7 +1018,7 @@ begin
         osOS2:
             begin
                 dosgetinfoblocks(@tib,nil);
-                stackbottom:=longint(tib^.stack);
+                stackbottom:=cardinal(tib^.stack);
             end;
         osDPMI:
             stackbottom:=0;     {Not sure how to get it, but seems to be
@@ -958,7 +1056,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.12  2001-04-20 19:05:11  hajny
+  Revision 1.13  2001-05-20 18:40:32  hajny
+    * merging Carl's fixes from the fixes branch
+
+  Revision 1.12  2001/04/20 19:05:11  hajny
     * setne operand size fixed
 
   Revision 1.11  2001/03/21 23:29:40  florian

rtl/os2/sysutils.pp

@@ -529,7 +529,7 @@ begin
     if (os_mode = osDOS) or (os_mode = osDPMI) then
     {Function 36 is not supported in OS/2.}
         asm
-            movb 8(%ebp),%dl
+            movb Drive,%dl
             movb $0x36,%ah
             call syscall
             cmpw $-1,%ax
@@ -538,6 +538,7 @@ begin
             mulw %bx
             shll $16,%edx
             movw %ax,%dx
+            movl $0,%eax
             xchgl %edx,%eax
             leave
             ret
@@ -567,7 +568,7 @@ begin
     if (os_mode = osDOS) or (os_mode = osDPMI) then
         {Function 36 is not supported in OS/2.}
         asm
-            movb 8(%ebp),%dl
+            Drive,%dl
             movb $0x36,%ah
             call syscall
             movw %dx,%bx
@@ -577,6 +578,7 @@ begin
             mulw %bx
             shll $16,%edx
             movw %ax,%dx
+            movl $0,%eax
             xchgl %edx,%eax
             leave
             ret
@@ -704,7 +706,7 @@ end;
 procedure InitInternational;
 var Country: TCountryCode;
     CtryInfo: TCountryInfo;
-    Size: cardinal;
+    Size: longint;
     RC: longint;
 begin
     Size := 0;
@@ -759,7 +761,6 @@ begin
 end;
 
 
-
 {****************************************************************************
                               Initialization code
 ****************************************************************************}
@@ -774,7 +775,10 @@ end.
 
 {
   $Log$
-  Revision 1.9  2001-02-21 21:23:38  hajny
+  Revision 1.10  2001-05-20 18:40:33  hajny
+    * merging Carl's fixes from the fixes branch
+
+  Revision 1.9  2001/02/21 21:23:38  hajny
     * GetEnvironmentVariable now really merged
 
   Revision 1.8  2001/02/20 22:14:19  peter

rtl/os2/todo-os2.txt

@@ -16,6 +16,11 @@ finish PM support                             high
           - PMBitmap................................................RB
     - PMStdDlg
 
+RTL
+    - sockets
+    - graph
+    - pass dos compatibility tests
+
 ? enhance ld linker                           high
 
 libgdb                                        medium