* GetDir fixed

rtl/go32v1/system.pp

@@ -532,26 +532,23 @@ begin
 end;
 
 
-function GetDirIO (DriveNr: byte; var Dir: ShortString): word;
-                                               [public, alias: 'FPC_GETDIRIO'];
+procedure GetDir (DriveNr: byte; var Dir: ShortString);
 var
   temp : array[0..255] of char;
   sof  : pchar;
   i    : byte;
-  IOR: word;
 begin
   sof:=pchar(@dir[4]);
 { dir[1..3] will contain '[drivenr]:\', but is not supplied by DOS,
   so we let dos string start at dir[4]
   Get dir from drivenr : 0=default, 1=A etc }
-  IOR := 0;
   asm
         movb    drivenr,%dl
         movl    sof,%esi
         mov     $0x47,%ah
         int     $0x21
         jnc .LGetDir
-        movw %ax, IOR
+        movw %ax, InOutRes
 .LGetDir:
   end;
 { Now Dir should be filled with directory in ASCIIZ starting from dir[4] }
@@ -584,14 +581,8 @@ begin
      dir[1]:=chr(i);
    end;
   dir:=upcase(dir);
-  GetDirIO := IOR;
 end;
 
-procedure GetDir (DriveNr: byte; var Dir: ShortString);
-
-begin
-    InOutRes := GetDirIO (DriveNr, Dir);
-end;
 
 {*****************************************************************************
                          System Dependent Exit code
@@ -628,7 +619,10 @@ Begin
 End.
 {
   $Log$
-  Revision 1.3  2001-03-10 09:57:51  hajny
+  Revision 1.4  2001-03-21 21:08:20  hajny
+    * GetDir fixed
+
+  Revision 1.3  2001/03/10 09:57:51  hajny
     * FExpand without IOResult change, remaining direct asm removed
 
   Revision 1.2  2000/07/13 11:33:38  michael

rtl/go32v2/system.pp

@@ -1280,15 +1280,12 @@ begin
 end;
 
 
-function GetDirIO (DriveNr: byte; var Dir: ShortString): word;
-                                               [public, alias: 'FPC_GETDIRIO'];
+procedure GetDir (DriveNr: byte; var Dir: ShortString);
 var
   temp : array[0..255] of char;
   i    : longint;
   regs : trealregs;
-  IOR: word;
 begin
-  IOR := 0;
   regs.realedx:=drivenr;
   regs.realesi:=tb_offset;
   regs.realds:=tb_segment;
@@ -1301,7 +1298,7 @@ begin
   sysrealintr($21,regs);
   if (regs.realflags and carryflag) <> 0 then
    Begin
-     IOR := lo(regs.realeax);
+     GetInOutRes (lo(regs.realeax));
      exit;
    end
   else
@@ -1334,12 +1331,6 @@ begin
    end;
 end;
 
-procedure GetDir (DriveNr: byte; var Dir: ShortString);
-
-begin
-  GetInOutRes (GetDirIO (DriveNr, Dir));
-end;
-
 
 {*****************************************************************************
                          SystemUnit Initialization
@@ -1426,7 +1417,10 @@ Begin
 End.
 {
   $Log$
-  Revision 1.5  2001-03-16 20:09:58  hajny
+  Revision 1.6  2001-03-21 21:08:20  hajny
+    * GetDir fixed
+
+  Revision 1.5  2001/03/16 20:09:58  hajny
     * universal FExpand
 
   Revision 1.4  2001/02/20 21:31:12  peter

rtl/inc/fexpand.inc

@@ -18,11 +18,19 @@
 
 
 function GetDirIO (DriveNr: byte; var Dir: OpenString): word;
-                                                [external name 'FPC_GETDIRIO'];
 
 (* GetDirIO is supposed to return the root of the given drive   *)
 (* in case of an error for compatibility of FExpand with TP/BP. *)
-(* Dir must be specified as OpenString since System has $P+.    *)
+
+var
+  OldInOutRes: word;
+begin
+  OldInOutRes := InOutRes;
+  InOutRes := 0;
+  GetDir (DriveNr, Dir);
+  GetDirIO := InOutRes;
+  InOutRes := OldInOutRes;
+end;
 
 
 function FExpand (const Path: PathStr): PathStr;
@@ -199,7 +207,10 @@ end;
 
 {
   $Log$
-  Revision 1.4  2001-03-19 21:09:30  hajny
+  Revision 1.5  2001-03-21 21:08:20  hajny
+    * GetDir fixed
+
+  Revision 1.4  2001/03/19 21:09:30  hajny
     * one more problem in the Unix part
 
   Revision 1.3  2001/03/19 21:05:42  hajny

rtl/os2/system.pas

@@ -771,14 +771,12 @@ end;
 
 {$ASMMODE ATT}
 
-function GetDirIO (DriveNr: byte; var Dir: ShortString): word;
-                                               [public, alias: 'FPC_GETDIRIO'];
+procedure GetDir (DriveNr: byte; var Dir: ShortString);
 
 {Written by Michael Van Canneyt.}
 
 var sof:Pchar;
     i:byte;
-    IOR: word;
 
 begin
     Dir [4] := #0;
@@ -788,14 +786,13 @@ begin
     { supplied by DOS, so we let dos string start at   }
     { dir[4]                                           }
     { Get dir from drivenr : 0=default, 1=A etc... }
-    IOR := 0;
     asm
         movb drivenr,%dl
         movl sof,%esi
         mov  $0x47,%ah
         call syscall
         jnc .LGetDir
-        movw %ax, IOR
+        movw %ax, InOutRes
 .LGetDir:
     end;
     { Now Dir should be filled with directory in ASCIIZ, }
@@ -829,13 +826,6 @@ begin
             dir[1]:=char(i);
         end;
     if not (FileNameCaseSensitive) then dir:=upcase(dir);
-    GetDirIO := IOR;
-end;
-
-procedure GetDir (DriveNr: byte; var Dir: ShortString);
-
-begin
-    InOutRes := GetDirIO (DriveNr, Dir);
 end;
 
 
@@ -964,7 +954,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.9  2001-03-10 09:57:51  hajny
+  Revision 1.10  2001-03-21 21:08:20  hajny
+    * GetDir fixed
+
+  Revision 1.9  2001/03/10 09:57:51  hajny
     * FExpand without IOResult change, remaining direct asm removed
 
   Revision 1.8  2001/02/20 21:31:12  peter

rtl/unix/sysunix.inc

@@ -482,8 +482,7 @@ Begin
 End;
 
 
-function GetDirIO (DriveNr: byte; var Dir: ShortString): word;
-                                               [public, alias: 'FPC_GETDIRIO'];
+procedure GetDir (DriveNr: byte; var Dir: ShortString);
 var
   thisdir      : stat;
   rootino,
@@ -498,7 +497,6 @@ var
   mountpoint,validdir : boolean;
   predot       : string[255];
 begin
-  GetDirIO := 0;
   drivenr:=0;
   dir:='';
   thedir:='/'#0;
@@ -554,12 +552,6 @@ begin
   dir:=thedir
 end;
 
-procedure GetDir (DriveNr: byte; var Dir: ShortString);
-
-begin
-    InOutRes := GetDirIO (DriveNr, Dir);
-end;
-
 
 {*****************************************************************************
                          SystemUnit Initialization
@@ -754,7 +746,10 @@ End.
 
 {
   $Log$
-  Revision 1.6  2001-03-16 20:09:58  hajny
+  Revision 1.7  2001-03-21 21:08:20  hajny
+    * GetDir fixed
+
+  Revision 1.6  2001/03/16 20:09:58  hajny
     * universal FExpand
 
   Revision 1.5  2001/02/20 21:31:12  peter

rtl/win32/system.pp

@@ -640,23 +640,23 @@ begin
   dirfn(TDirFnType(@SetCurrentDirectory),s);
 end;
 
-function GetDirIO (DriveNr: byte; var Dir: ShortString): word;
-                                               [public, alias: 'FPC_GETDIRIO'];
+procedure GetDir (DriveNr: byte; var Dir: ShortString);
 const
   Drive:array[0..3]of char=(#0,':',#0,#0);
 var
   defaultdrive:boolean;
   DirBuf,SaveBuf:array[0..259] of Char;
-  IOR: word;
 begin
-  IOR := 0;
   defaultdrive:=drivenr=0;
   if not defaultdrive then
    begin
     byte(Drive[0]):=Drivenr+64;
     GetCurrentDirectory(SizeOf(SaveBuf),SaveBuf);
     if SetCurrentDirectory(@Drive) <> 0 then
-     IOR := word (GetLastError);
+     begin
+      errno := word (GetLastError);
+      Errno2InoutRes;
+     end;
    end;
   GetCurrentDirectory(SizeOf(DirBuf),DirBuf);
   if not defaultdrive then
@@ -664,14 +664,6 @@ begin
   dir:=strpas(DirBuf);
   if not FileNameCaseSensitive then
    dir:=upcase(dir);
-  GetDirIO := IOR;
-end;
-
-procedure GetDir (DriveNr: byte; var Dir: ShortString);
-
-begin
-  errno := GetDirIO (DriveNr, Dir);
-  Errno2InoutRes;
 end;
 
 
@@ -1438,7 +1430,10 @@ end.
 
 {
   $Log$
-  Revision 1.7  2001-03-16 20:09:58  hajny
+  Revision 1.8  2001-03-21 21:08:20  hajny
+    * GetDir fixed
+
+  Revision 1.7  2001/03/16 20:09:58  hajny
     * universal FExpand
 
   Revision 1.6  2001/02/20 21:31:12  peter