* FExpand without IOResult change, remaining direct asm removed

rtl/go32v1/dos.pp

@@ -539,100 +539,18 @@ begin
 end;
 
 
-    function fexpand(const path : pathstr) : pathstr;
-       var
-         s,pa : pathstr;
-         i,j  : longint;
-       begin
-          getdir(0,s);
-          if LFNSupport then
-           begin
-             pa:=path;
-             { Always uppercase driveletter }
-             if (length(pa)>1) and (pa[2]=':') and (pa[1] in ['a'..'z']) then
-              pa[1]:=CHR(ORD(Pa[1])-32);
-           end
-          else
-           pa:=upcase(path);
-          { allow slash as backslash }
-          for i:=1 to length(pa) do
-           if pa[i]='/' then
-            pa[i]:='\';
-
-          if (length(pa)>1) and (pa[2]=':') and (pa[1] in ['A'..'Z']) then
-            begin
-               { we must get the right directory }
-               getdir(ord(pa[1])-ord('A')+1,s);
-               if (ord(pa[0])>2) and (pa[3]<>'\') then
-                 if pa[1]=s[1] then
-                   begin
-                     { remove ending slash if it already exists }
-                     if s[length(s)]='\' then
-                      dec(s[0]);
-                     pa:=s+'\'+copy (pa,3,length(pa));
-                   end
-                 else
-                   pa:=pa[1]+':\'+copy (pa,3,length(pa))
-            end
-          else
-            if pa[1]='\' then
-              pa:=s[1]+':'+pa
-            else if s[0]=#3 then
-              pa:=s+pa
-            else
-              pa:=s+'\'+pa;
-
-        { Turbo Pascal gives current dir on drive if only drive given as parameter! }
-        if length(pa) = 2 then
-         begin
-           getdir(byte(pa[1])-64,s);
-           pa := s;
-         end;
+(*
+function FExpand (const Path: PathStr): PathStr;
+- declared in fexpand.inc
+*)
+
+{$DEFINE FPC_FEXPAND_UNC} (* UNC paths are supported *)
+{$DEFINE FPC_FEXPAND_DRIVES} (* Full paths begin with drive specification *)
 
-        {First remove all references to '\.\'}
-          while pos ('\.\',pa)<>0 do
-           delete (pa,pos('\.\',pa),2);
-        {Now remove also all references to '\..\' + of course previous dirs..}
-          repeat
-            i:=pos('\..\',pa);
-            if i<>0 then
-             begin
-               j:=i-1;
-               while (j>1) and (pa[j]<>'\') do
-                dec (j);
-               if pa[j+1] = ':' then j := 3;
-               delete (pa,j,i-j+3);
-             end;
-          until i=0;
-
-          { Turbo Pascal gets rid of a \.. at the end of the path }
-          { Now remove also any reference to '\..'  at end of line
-            + of course previous dir.. }
-          i:=pos('\..',pa);
-          if i<>0 then
-           begin
-             if i = length(pa) - 2 then
-              begin
-                j:=i-1;
-                while (j>1) and (pa[j]<>'\') do
-                 dec (j);
-                delete (pa,j,i-j+3);
-              end;
-              pa := pa + '\';
-            end;
-          { Remove End . and \}
-          if (length(pa)>0) and (pa[length(pa)]='.') then
-           dec(byte(pa[0]));
-          { if only the drive + a '\' is left then the '\' should be left to prevtn the program
-            accessing the current directory on the drive rather than the root!}
-          { if the last char of path = '\' then leave it in as this is what TP does! }
-          if ((length(pa)>3) and (pa[length(pa)]='\')) and (path[length(path)] <> '\') then
-           dec(byte(pa[0]));
-          { if only a drive is given in path then there should be a '\' at the
-            end of the string given back }
-          if length(pa) = 2 then pa := pa + '\';
-          fexpand:=pa;
-       end;
+{$I fexpand.inc}
+
+{$UNDEF FPC_FEXPAND_DRIVES}
+{$UNDEF FPC_FEXPAND_UNC}
 
 
 Function FSearch(path: pathstr; dirlist: string): pathstr;
@@ -791,7 +709,10 @@ End;
 end.
 {
   $Log$
-  Revision 1.2  2000-07-13 11:33:38  michael
+  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
   + removed logs
  
 }

rtl/go32v1/system.pp

@@ -532,21 +532,27 @@ begin
 end;
 
 
-procedure getdir(drivenr : byte;var dir : shortstring);
+function GetDirIO (DriveNr: byte; var Dir: ShortString): word;
+                                               [public, alias: 'FPC_GETDIRIO'];
 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
+.LGetDir:
   end;
 { Now Dir should be filled with directory in ASCIIZ starting from dir[4] }
   dir[0]:=#3;
@@ -563,7 +569,6 @@ begin
      inc(i);
    end;
 { upcase the string }
-  dir:=upcase(dir);
   if drivenr<>0 then   { Drive was supplied. We know it }
    dir[1]:=chr(65+drivenr-1)
   else
@@ -578,6 +583,14 @@ begin
      end;
      dir[1]:=chr(i);
    end;
+  dir:=upcase(dir);
+  GetDirIO := IOR;
+end;
+
+procedure GetDir (DriveNr: byte; var Dir: ShortString);
+
+begin
+    InOutRes := GetDirIO (DriveNr, Dir);
 end;
 
 {*****************************************************************************
@@ -615,7 +628,10 @@ Begin
 End.
 {
   $Log$
-  Revision 1.2  2000-07-13 11:33:38  michael
+  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
   + removed logs
  
 }

rtl/inc/fexpand.inc

@@ -1,32 +1,51 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1997-2000 by the Free Pascal development team
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{****************************************************************************
+                A platform independent FExpand implementation
+****************************************************************************}
+
+
+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+.    *)
+
+
+function FExpand (const Path: PathStr): PathStr;
+
 (* LFNSupport boolean constant, variable or function must be declared for all
    the platforms, at least locally in the Dos unit implementation part.
-   In addition, FEXPAND_UNC, FEXPAND_DRIVES, FEXPAND_GETENV_PCHAR
-   and FEXPAND_TILDE conditionals might be defined to specify FExpand
+   In addition, FPC_FEXPAND_UNC, FPC_FEXPAND_DRIVES, FPC_FEXPAND_GETENV_PCHAR
+   and FPC_FEXPAND_TILDE conditionals might be defined to specify FExpand
    behaviour. Only forward slashes are supported if UNIX conditional
    is defined, both forward and backslashes otherwise.
 *)
 
-(* TODO: GetDir replacement function should appear here to remove
-   the incorrect setting of IOResult within FExpand.
-*)
-{
-    function get_current_drive:byte;assembler;
-    asm
-        movb $0x19,%ah
-        call syscall
-    end;
-}
 const
 {$IFDEF UNIX}
     DirSep = '/';
 {$ELSE UNIX}
     DirSep = '\';
 {$ENDIF UNIX}
-{$IFDEF FEXPAND_DRIVES}
+{$IFDEF FPC_FEXPAND_DRIVES}
     PathStart = 3;
-{$ELSE FEXPAND_DRIVES}
+{$ELSE FPC_FEXPAND_DRIVES}
     PathStart = 1;
-{$ENDIF FEXPAND_DRIVES}
+{$ENDIF FPC_FEXPAND_DRIVES}
 
 var S, Pa: PathStr;
     I, J: longint;
@@ -42,15 +61,16 @@ begin
         if Pa [I] = '/' then
             Pa [I] := DirSep;
 {$ENDIF}
-{$IFDEF FEXPAND_TILDE}
+{$IFDEF FPC_FEXPAND_TILDE}
     {Replace ~/ with $HOME}
-    if (Length (Pa) > 1) and (Pa [1] ='~') and (Pa [2] = DirSep) then
+    if (Length (Pa) >= 1) and (Pa [1] ='~') and 
+                                  ((Pa [2] = DirSep) or (Length (Pa) = 1)) then
         begin
- {$IFDEF FEXPAND_GETENV_PCHAR}
+ {$IFDEF FPC_FEXPAND_GETENV_PCHAR}
             S := StrPas (GetEnv ('HOME'));
- {$ELSE FEXPAND_GETENV_PCHAR}
+ {$ELSE FPC_FEXPAND_GETENV_PCHAR}
             S := GetEnv ('HOME');
- {$ENDIF FEXPAND_GETENV_PCHAR}
+ {$ENDIF FPC_FEXPAND_GETENV_PCHAR}
             if (S = '') or (Length (S) = 1) and (S [1] = DirSep) then
                 Delete (Pa, 1, 1)
             else
@@ -59,27 +79,15 @@ begin
                 else
                     Pa := S + Copy (Pa, 2, Pred (Length (Pa)));
    end;
-{$ENDIF FEXPAND_TILDE}
+{$ENDIF FPC_FEXPAND_TILDE}
     if (Length (Pa) > 1) and (Pa [1] in ['A'..'Z', 'a'..'z']) and
                                                             (Pa [2] = ':') then
         begin
-{$IFDEF FEXPAND_DRIVES}
+{$IFDEF FPC_FEXPAND_DRIVES}
             { Always uppercase driveletter }
             if (Pa [1] in ['a'..'z']) then
                 Pa [1] := Chr (Ord (Pa [1]) and not ($20));
-            {We must get the right directory (should be changed to avoid
-            touching IOResult)}
- {$IFOPT I+}
-  {$DEFINE FEXPAND_WAS_I}
-  {$I-}
- {$ENDIF}
-            I := IOResult;
-            GetDir (Ord (Pa [1]) - Ord ('A') + 1, S);
-            I := IOResult;
- {$IFDEF FEXPAND_WAS_I}
-  {$I+}
-  {$UNDEF FEXPAND_WAS_I}
- {$ENDIF FEXPAND_WAS_I}
+            if GetDirIO (Ord (Pa [1]) - Ord ('A') + 1, S) = 0 then ;
             case Length (Pa) of
                 2: Pa := S;
             else
@@ -96,35 +104,25 @@ begin
             end;
         end
     else
-{$ELSE FEXPAND_DRIVES}
+{$ELSE FPC_FEXPAND_DRIVES}
             Delete (Path, 1, 2);
             Delete (Pa, 1, 2);
         end;
-{$ENDIF FEXPAND_DRIVES}
+{$ENDIF FPC_FEXPAND_DRIVES}
         begin
-{$IFOPT I+}
- {$DEFINE FEXPAND_WAS_I}
- {$I-}
-{$ENDIF}
-            I := IOResult;
-            GetDir (0, S);
-            I := IOResult;
-{$IFDEF FEXPAND_WAS_I}
- {$I+}
- {$UNDEF FEXPAND_WAS_I}
-{$ENDIF FEXPAND_WAS_I}
-{$IFDEF FEXPAND_DRIVES}
+            if GetDirIO (0, S) = 0 then ;
+{$IFDEF FPC_FEXPAND_DRIVES}
             if (Length (Pa) > 0) and (Pa [1] = DirSep) then
                 begin
- {$IFDEF FEXPAND_UNC}
+ {$IFDEF FPC_FEXPAND_UNC}
                     { Do not touch Network drive names }
                     if not ((Length (Pa) > 1) and (Pa [2] = Pa [1])
                                                            and LFNSupport) then
- {$ENDIF FEXPAND_UNC}
+ {$ENDIF FPC_FEXPAND_UNC}
                         Pa := S [1] + ':' + Pa
                 end
             else
-{$ENDIF FEXPAND_DRIVES}
+{$ENDIF FPC_FEXPAND_DRIVES}
                 (* We already have a slash if root is the curent directory. *)
                 if Length (S) = PathStart then
                     Pa := S + Pa
@@ -151,9 +149,9 @@ begin
             while (J > 0) and (Pa [J] <> DirSep) do
                 Dec (J);
             if (J = 0)
-{$IFDEF FEXPAND_UNC}
+{$IFDEF FPC_FEXPAND_UNC}
                        or (J = 1) and (I = 2)
-{$ENDIF FEXPAND_UNC}
+{$ENDIF FPC_FEXPAND_UNC}
                                               then
                 Delete (Pa, Succ (I), 3)
             else
@@ -169,9 +167,9 @@ begin
             while (J >= 1) and (Pa [J] <> DirSep) do
                 Dec (J);
             if (J = 0)
-{$IFDEF FEXPAND_UNC}
+{$IFDEF FPC_FEXPAND_UNC}
                        or (J = 1) and (I = 2)
-{$ENDIF FEXPAND_UNC}
+{$ENDIF FPC_FEXPAND_UNC}
                                               then
                 Delete (Pa, Succ (I), 2)
             else
@@ -180,14 +178,15 @@ begin
     {Now remove also any reference to '\.' at the end of line}
     I := Pos (DirSep + '.', Pa);
     if (I <> 0) and (I = Pred (Length (Pa))) then
-        if (I = PathStart)
-{$IFDEF FEXPAND_DRIVES}
-                           and (Pa [2] = ':')
-{$ENDIF FEXPAND_DRIVES}
-{$IFDEF FEXPAND_UNC}
-                                              or (I = 2) and (Pa [1] = '\')
-{$ENDIF FEXPAND_UNC}
-                                                                           then
+{$IFDEF FPC_FEXPAND_DRIVES}
+        if (I = 3) and (Pa [2] = ':')
+{$ELSE FPC_FEXPAND_DRIVES}
+        if (I = 1)
+{$ENDIF FPC_FEXPAND_DRIVES}
+{$IFDEF FPC_FEXPAND_UNC}
+                                      or (I = 2) and (Pa [1] = '\')
+{$ENDIF FPC_FEXPAND_UNC}
+                                                                    then
             Dec (Pa [0])
         else
             Delete (Pa, I, 2);
@@ -198,3 +197,11 @@ begin
         Dec (Pa [0]);
     FExpand := Pa;
 end;
+
+{
+  $Log$
+  Revision 1.2  2001-03-10 09:57:51  hajny
+    * FExpand without IOResult change, remaining direct asm removed
+
+ 
+}

rtl/os2/dos.pas

@@ -182,6 +182,7 @@ uses    DosCalls;
 
 var     LastSR: SearchRec;
         envc: longint; external name '_envc';
+        EnvP: ppchar; external name '_environ';
 
 type    TBA = array [1..SizeOf (SearchRec)] of byte;
         PBA = ^TBA;
@@ -460,31 +461,27 @@ begin
      Oh boy, I always had the opinion that executing a program under Dos
      was a hard job!}
 
-    {$ASMMODE DIRECT}
-
     asm
         movl env,%edi       {Setup destination pointer.}
-        movl _envc,%ecx     {Load number of arguments in edx.}
-        movl _environ,%esi  {Load env. strings.}
+        movl envc,%ecx      {Load number of arguments in edx.}
+        movl envp,%esi      {Load env. strings.}
         xorl %edx,%edx      {Count environment size.}
-    exa1:
+.Lexa1:
         lodsl               {Load a Pchar.}
         xchgl %eax,%ebx
-    exa2:
+.Lexa2:
         movb (%ebx),%al     {Load a byte.}
         incl %ebx           {Point to next byte.}
         stosb               {Store it.}
         incl %edx           {Increase counter.}
         cmpb $0,%al         {Ready ?.}
-        jne exa2
-        loop exa1           {Next argument.}
+        jne .Lexa2
+        loop .Lexa1           {Next argument.}
         stosb               {Store an extra 0 to finish. (AL is now 0).}
         incl %edx
-        movl %edx,(24)es    {Store environment size.}
+        movw %dx,ES.SizeEnv    {Store environment size.}
     end;
 
-    {$ASMMODE ATT}
-
     {Environment ready, now set-up exec structure.}
     es.argofs:=args;
     es.envofs:=env;
@@ -988,17 +985,21 @@ begin
     name:=path;
 end;
 
+(*
 function FExpand (const Path: PathStr): PathStr;
+- declared in fexpand.inc
+*)
 
-{$DEFINE FEXPAND_UNC} (* UNC paths are supported *)
-{$DEFINE FEXPAND_DRIVES} (* Full paths begin with drive specification *)
+{$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 FEXPAND_DRIVES}
-{$UNDEF FEXPAND_UNC}
+
+{$UNDEF FPC_FEXPAND_DRIVES}
+{$UNDEF FPC_FEXPAND_UNC}
 
 procedure packtime(var d:datetime;var time:longint);
 
@@ -1066,7 +1067,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.7  2001-02-04 01:57:52  hajny
+  Revision 1.8  2001-03-10 09:57:51  hajny
+    * FExpand without IOResult change, remaining direct asm removed
+
+  Revision 1.7  2001/02/04 01:57:52  hajny
     * direct asm removing
 
   Revision 1.6  2000/11/06 20:35:05  hajny

rtl/os2/system.pas

@@ -771,25 +771,32 @@ end;
 
 {$ASMMODE ATT}
 
-procedure getdir(drivenr : byte;var dir : shortstring);
+function GetDirIO (DriveNr: byte; var Dir: ShortString): word;
+                                               [public, alias: 'FPC_GETDIRIO'];
 
 {Written by Michael Van Canneyt.}
 
-var temp:array[0..255] of char;
-    sof:Pchar;
+var sof:Pchar;
     i:byte;
+    IOR: word;
 
 begin
+    Dir [4] := #0;
+    { Used in case the specified drive isn't available }
     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
         call syscall
+        jnc .LGetDir
+        movw %ax, IOR
+.LGetDir:
     end;
     { Now Dir should be filled with directory in ASCIIZ, }
     { starting from dir[4]                               }
@@ -807,9 +814,8 @@ begin
             inc(i);
         end;
     { upcase the string (FPC function) }
-    if not (FileNameCaseSensitive) then dir:=upcase(dir);
     if drivenr<>0 then   { Drive was supplied. We know it }
-        dir[1]:=char(65+drivenr-1)
+        dir[1]:=chr(64+drivenr)
     else
         begin
             { We need to get the current drive from DOS function 19H  }
@@ -822,13 +828,21 @@ begin
             end;
             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;
 
 
 {****************************************************************************
 
                              Thread Handling
+
 *****************************************************************************}
 
 const
@@ -845,6 +859,7 @@ end;
 {$I thread.inc}
 
 {*****************************************************************************
+
                         System unit initialization.
 
 ****************************************************************************}
@@ -949,7 +964,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.8  2001-02-20 21:31:12  peter
+  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
     * chdir,mkdir,rmdir with empty string fixed
 
   Revision 1.7  2001/02/04 01:57:52  hajny