Explorar o código

* updated behavior of some routines to conform to docs (completely taken from fixes branch)

carl %!s(int64=24) %!d(string=hai) anos
pai
achega
2c93d32ff3
Modificáronse 1 ficheiros con 147 adicións e 79 borrados
  1. 147 79
      rtl/os2/dos.pas

+ 147 - 79
rtl/os2/dos.pas

@@ -180,7 +180,7 @@ function getenv(const envvar:string): string;
 implementation
 
 var     LastSR: SearchRec;
-        envc: longint; external name '_envc';
+        EnvC: longint; external name '_envc';
         EnvP: ppchar; external name '_environ';
 
 type    TBA = array [1..SizeOf (SearchRec)] of byte;
@@ -316,7 +316,7 @@ procedure msdos(var regs:registers);
 
 begin
    if os_mode in [osDPMI,osDOS] then
-    intr($21,regs);
+     intr($21,regs);
 end;
 
 procedure intr(intno:byte;var regs:registers);
@@ -325,14 +325,14 @@ procedure intr(intno:byte;var regs:registers);
 
 begin
   if os_mode = osos2 then exit;
-asm
+  asm
     jmp .Lstart
 {    .data}
 .Lint86:
-    .byte   0xcd
+    .byte        0xcd
 .Lint86_vec:
-    .byte   0x03
-    jmp     .Lint86_retjmp
+    .byte        0x03
+    jmp          .Lint86_retjmp
 
 {    .text}
 .Lstart:
@@ -383,7 +383,7 @@ asm
     popl    %ebx            {Flags.}
     movl    %ebx,32(%eax)
     {FS and GS too}
-end;
+  end;
 end;
 
 procedure exec(const path:pathstr;const comline:comstr);
@@ -642,22 +642,12 @@ end;
 procedure getcbreak(var breakvalue:boolean);
 
 begin
-    DosError := 0;
-{! Do not use in OS/2. Also not recommended in DOS. Use
-        signal handling instead.
-    asm
-        movw $0x3300,%ax
-        call syscall
-        movl BreakValue,%eax
-        movb %dl,(%eax)
-    end;
-}
+    breakvalue := True;
 end;
 
 procedure setcbreak(breakvalue:boolean);
 
 begin
-    DosError := 0;
 {! Do not use in OS/2. Also not recommended in DOS. Use
        signal handling instead.
     asm
@@ -671,29 +661,30 @@ end;
 procedure getverify(var verify:boolean);
 
 begin
-    DosError := 0;
-    {! Do not use in OS/2.}
-    if os_mode in [osDOS,osDPMI] then
-        asm
-            movb $0x54,%ah
-            call syscall
-            movl verify,%edi
-            stosb
-        end;
-end;
+  {! Do not use in OS/2.}
+  if os_mode in [osDOS,osDPMI] then
+      asm
+         movb $0x54,%ah
+         call syscall
+         movl verify,%edi
+         stosb
+      end
+  else
+      verify := true;
+  end;
 
 procedure setverify(verify:boolean);
 
 begin
-    DosError := 0;
-    {! Do not use in OS/2!}
-    if os_mode in [osDOS,osDPMI] then
-        asm
-            movb verify,%al
-            movb $0x2e,%ah
-            call syscall
-        end;
-end;
+  {! Do not use in OS/2!}
+  if os_mode in [osDOS,osDPMI] then
+    asm
+        movb verify,%al
+        movb $0x2e,%ah
+        call syscall
+    end;
+ end;
+
 
 function DiskFree (Drive: byte): int64;
 
@@ -811,7 +802,7 @@ begin
     begin
         Name := FStat^.Name;
         Size := FStat^.FileSize;
-        Attr := FStat^.AttrFile;
+        Attr := byte(FStat^.AttrFile and $FF);
         TRec (Time).T := FStat^.TimeLastWrite;
         TRec (Time).D := FStat^.DateLastWrite;
     end else
@@ -861,8 +852,8 @@ begin
         New (F.FStat);
         F.Handle := $FFFFFFFF;
         Count := 1;
-        DosError := DosFindFirst (Path, F.Handle, Attr, F.FStat,
-                                         SizeOf (F.FStat^), Count, ilStandard);
+        DosError := Integer(DosFindFirst (Path, F.Handle, Attr, F.FStat,
+                                         SizeOf (F.FStat^), Count, ilStandard));
         if (DosError = 0) and (Count = 0) then DosError := 18;
     end else
     begin
@@ -897,7 +888,7 @@ begin
     if os_mode = osOS2 then
     begin
         Count := 1;
-        DosError := DosFindNext (F.Handle, F.FStat, SizeOf (F.FStat^), Count);
+        DosError := Integer(DosFindNext (F.Handle, F.FStat, SizeOf (F.FStat^), Count));
         if (DosError = 0) and (Count = 0) then DosError := 18;
     end else _findnext (F);
     DosSearchRec2SearchRec (F);
@@ -968,8 +959,12 @@ procedure fsplit(path:pathstr;var dir:dirstr;var name:namestr;
                  var ext:extstr);
 
 var p1,i : longint;
+    dotpos : integer;
 
 begin
+    { allow slash as backslash }
+    for i:=1 to length(path) do
+      if path[i]='/' then path[i]:='\';
     {Get drive name}
     p1:=pos(':',path);
     if p1>0 then
@@ -984,23 +979,26 @@ begin
     while true do
         begin
             p1:=pos('\',path);
-            if p1=0 then
-                p1:=pos('/',path);
             if p1=0 then
                 break;
             dir:=dir+copy(path,1,p1);
               delete(path,1,p1);
         end;
-    {Try to find an extension.}
-    ext:='';
-    for i:=length(path) downto 1 do
-        if path[i]='.' then
-            begin
-                ext:=copy(path,i,high(extstr));
-                delete(path,i,length(path)-i+1);
-                break;
-            end;
-    name:=path;
+   { try to find out a extension }
+   Ext:='';
+   i:=Length(Path);
+   DotPos:=256;
+   While (i>0) Do
+     Begin
+       If (Path[i]='.') Then
+         begin
+           DotPos:=i;
+           break;
+         end;
+       Dec(i);
+     end;
+   Ext:=Copy(Path,DotPos,255);
+   Name:=Copy(Path,1,DotPos - 1);
 end;
 
 (*
@@ -1011,6 +1009,9 @@ function FExpand (const Path: PathStr): PathStr;
 {$DEFINE FPC_FEXPAND_UNC} (* UNC paths are supported *)
 {$DEFINE FPC_FEXPAND_DRIVES} (* Full paths begin with drive specification *)
 
+const
+    LFNSupport = true;
+
 {$I fexpand.inc}
 
 {$UNDEF FPC_FEXPAND_DRIVES}
@@ -1068,7 +1069,7 @@ begin
   path:=FExPand(path);
   move(path[1],buffer,length(path));
   buffer[length(path)]:=#0;
-asm
+ asm
     movw $0x4300,%ax
     leal buffer,%edx
     call syscall
@@ -1096,8 +1097,8 @@ begin
   path:=FExPand(path);
   move(path[1],buffer,length(path));
   buffer[length(path)]:=#0;
-asm
-    movw $0x4301,%ax
+   asm
+     movw $0x4301,%ax
      leal buffer,%edx
      movw attr,%cx
      call syscall
@@ -1175,43 +1176,110 @@ begin
 end.
 {
   $Log$
-  Revision 1.14  2001-10-05 01:35:48  carl
+  Revision 1.15  2001-11-23 00:35:02  carl
+  * updated behavior of some routines to conform to docs (completely taken from fixes branch)
+
+  Revision 1.1.2.14  2001/11/23 00:33:17  carl
+  * updated behavior of some routines to conform to docs
+
+  Revision 1.1.2.13  2001/11/20 03:32:09  carl
+  * range check errors fixes
+
+  Revision 1.1.2.12  2001/10/05 01:36:18  carl
   * corrected assembler syntax error
 
-  Revision 1.13  2001/06/13 22:21:53  hajny
-    + platform specific information
+  Revision 1.1.2.11  2001/06/06 01:30:04  carl
+  + small modification from go32v2 LFN version (fsplit)
+  * now support / but returns always \ (as it should) (fsplit)
 
-  Revision 1.12  2001/05/21 20:50:19  hajny
+  Revision 1.1.2.10  2001/05/21 20:51:43  hajny
     * silly mistyping corrected
 
-  Revision 1.11  2001/05/20 18:55:48  hajny
-    * merging Carl's fixes from the fixes branch
+  Revision 1.1.2.9  2001/05/20 18:55:12  hajny
+    * fix for Carl's Exec modification
 
-  Revision 1.10  2001/04/10 18:49:40  hajny
-    * better check for FindClose
+  Revision 1.1.2.8  2001/05/20 15:05:02  hajny
+    DiskSize/DiskFree EMX mode corrections
 
-  Revision 1.9  2001/03/11 18:58:42  hajny
-    * another Find* problem :-(
+  Revision 1.1.2.7  2001/05/14 19:22:53  carl
+  + More DosError results
+  * GetFattr handle bug
+  * SetFTime handle bug
+  * Passing the environment in exec() now works
+  * Correct flags set with exec()
+  * Buffer overflow for setftime()
+  * Fixed a bug that i added with my last commit, environment pointers under OS/2 were not always setup correctly.
 
-  Revision 1.8  2001/03/10 09:57:51  hajny
-    * FExpand without IOResult change, remaining direct asm removed
+  Revision 1.1.2.6  2001/05/12 03:11:39  carl
+  * fix of environment pointer under real OS/2
+  * fix problems with _findfirst() , _findnext() under plain DOS
+  - remove all syscalls which are either unsupported in OS/2 or untested in EMX
+    (some of them i did test myself, and they crashed under plain DOS)
 
-  Revision 1.7  2001/02/04 01:57:52  hajny
-    * direct asm removing
+  Revision 1.1.2.5  2001/04/10 18:54:50  hajny
+    * better check for FindClose
 
-  Revision 1.6  2000/11/06 20:35:05  hajny
-    * common FExpand introduced
+  Revision 1.1.2.4  2001/03/11 19:07:14  hajny
+    * merging FExpand and Find* fixes
 
-  Revision 1.5  2000/11/05 22:21:47  hajny
+  Revision 1.1.2.3  2001/02/04 02:01:29  hajny
+    * direct asm removing, DosGetInfoBlocks change merged
+
+  Revision 1.1.2.2  2000/11/05 22:21:06  hajny
     * more FExpand fixes
 
-  Revision 1.4  2000/10/28 16:58:34  hajny
-    * many FExpand fixes
+  Revision 1.1.2.1  2000/10/28 16:59:50  hajny
+    * many FExpand fixes plus merging corrections made by Jonas in the main branch
+
+  Revision 1.1  2000/07/13 06:31:04  michael
+  + Initial import
+
+  Revision 1.28  2000/07/06 18:57:40  hajny
+    * SetFTime for OS/2 mode corrected
+
+  Revision 1.27  2000/06/05 18:50:55  hajny
+    * SetDate, SetTime corrected
+
+  Revision 1.26  2000/06/01 18:38:46  hajny
+    * warning about SetDate added (TODO)
+
+  Revision 1.25  2000/05/28 18:20:16  hajny
+    * DiskFree/DiskSize updated
+
+  Revision 1.24  2000/05/21 16:06:38  hajny
+    + FSearch and Find* reworked
+
+  Revision 1.23  2000/04/18 20:30:02  hajny
+    * FSearch with given path corrected
+
+  Revision 1.22  2000/03/12 18:32:17  hajny
+    * missing parentheses added
+
+  Revision 1.21  2000/03/05 19:00:37  hajny
+    * DiskFree, DiskSize - int64 result, fix for osDPMI mode
+
+  Revision 1.20  2000/02/09 16:59:33  peter
+    * truncated log
+
+  Revision 1.19  2000/01/09 20:51:03  hajny
+    * FPK changed to FPC
+
+  Revision 1.18  2000/01/07 16:41:45  daniel
+    * copyright 2000
+
+  Revision 1.17  1999/10/13 12:21:56  daniel
+  * OS/2 compiler works again.
+
+  Revision 1.16  1999/09/13 18:21:02  hajny
+    * again didn't manage to read docu for DosFindFirst properly :-(
+
+  Revision 1.15  1999/09/13 17:56:26  hajny
+    * another correction to FSearch fix - mistyping
 
-  Revision 1.3  2000/09/29 21:49:41  jonas
-    * removed warnings
+  Revision 1.14  1999/09/13 17:35:15  hajny
+    * little addition/correction to FSearch fix
 
-  Revision 1.2  2000/07/14 10:33:10  michael
-  + Conditionals fixed
+  Revision 1.13  1999/09/09 09:20:43  hajny
+    * FSearch under OS/2 fixed
 
 }