diff --git a/rtl/go32v1/system.pp b/rtl/go32v1/system.pp index 3712adf65a..3ccfa9001d 100644 --- a/rtl/go32v1/system.pp +++ b/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 diff --git a/rtl/go32v2/system.pp b/rtl/go32v2/system.pp index 38ef5dd06f..76c7447aeb 100644 --- a/rtl/go32v2/system.pp +++ b/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 diff --git a/rtl/inc/fexpand.inc b/rtl/inc/fexpand.inc index 709947a2fe..b64409bc3a 100644 --- a/rtl/inc/fexpand.inc +++ b/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 diff --git a/rtl/os2/system.pas b/rtl/os2/system.pas index 9bbd7912da..88724e6e2f 100644 --- a/rtl/os2/system.pas +++ b/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 diff --git a/rtl/unix/sysunix.inc b/rtl/unix/sysunix.inc index a07afb15ef..90322c350e 100644 --- a/rtl/unix/sysunix.inc +++ b/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 diff --git a/rtl/win32/system.pp b/rtl/win32/system.pp index 36af14dc82..79c9c8a8d7 100644 --- a/rtl/win32/system.pp +++ b/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