paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 07:26:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

* ChDir correction, unit name changed

Browse Source
This commit is contained in:
Tomas Hajny 2000-10-15 20:43:10 +00:00
parent dca128133b
commit e5736660df
1 changed files with 82 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

90
rtl/os2/system.pas
View File

@ -30,7 +30,7 @@
****************************************************************************} ****************************************************************************}
unit sysos2; unit {$ifdef VER1_0}sysos2{$else}System{$endif};
{Changelog: {Changelog:
@ -120,6 +120,12 @@ procedure DosGetInfoBlocks (var Atib: PThreadInfoBlock;
function DosSetRelMaxFH (var ReqCount, CurMaxFH: longint): longint; cdecl; function DosSetRelMaxFH (var ReqCount, CurMaxFH: longint): longint; cdecl;
external 'DOSCALLS' index 382; external 'DOSCALLS' index 382;
function DosSetCurrentDir (Name:PChar): longint; cdecl;
external 'DOSCALLS' index 255;
function DosSetDefaultDisk (DiskNum:longint): longint; cdecl;
external 'DOSCALLS' index 220;
{This is the correct way to call external assembler procedures.} {This is the correct way to call external assembler procedures.}
procedure syscall; external name '___SYSCALL'; procedure syscall; external name '___SYSCALL';
@ -632,31 +638,96 @@ begin
movb func,%ah movb func,%ah
call syscall call syscall
jnc .LDOS_DIRS1 jnc .LDOS_DIRS1
movw %ax,inoutres; movw %ax,inoutres
.LDOS_DIRS1: .LDOS_DIRS1:
end; end;
end; end;
procedure mkdir(const s : string); procedure MkDir (const S: string);
begin begin
DosDir($39,s); if InOutRes = 0 then
DosDir ($39, S);
end; end;
procedure rmdir(const s : string); procedure rmdir(const s : string);
begin begin
DosDir($3a,s); if InOutRes = 0 then
DosDir ($3A, S);
end; end;
procedure chdir(const s : string); {$ASMMODE INTEL}
procedure ChDir (const S: string);
var RC: longint;
Buffer: array [0..255] of char;
begin begin
DosDir($3b,s); if InOutRes = 0 then
begin
(* According to EMX documentation, EMX has only one current directory
for all processes, so we'll use native calls under OS/2. *)
if os_Mode = osOS2 then
begin
if (Length (S) >= 2) and (S [2] = ':') then
begin
RC := DosSetDefaultDisk ((Ord (S [1]) and
not ($20)) - $40);
if RC <> 0 then
InOutRes := RC
else
if Length (S) > 2 then
begin
Move (S [1], Buffer, Length (S));
Buffer [Length (S)] := #0;
AllowSlash (PChar (@Buffer));
RC := DosSetCurrentDir (@Buffer);
if RC <> 0 then
InOutRes := RC;
end;
end
else
begin
Move (S [1], Buffer, Length (S));
Buffer [Length (S)] := #0;
AllowSlash (PChar (@Buffer));
RC := DosSetCurrentDir (@Buffer);
if RC <> 0 then
InOutRes := RC;
end;
end
else
if (Length (S) >= 2) and (S [2] = ':') then
begin
asm
mov esi, S
mov al, [esi + 1]
and al, not (20h)
sub al, 41h
mov edx, eax
mov ah, 0Eh
call syscall
mov ah, 19h
call syscall
cmp al, dl
jz @LCHDIR
mov InOutRes, 15
@LCHDIR:
end;
if (Length (S) > 2) and (InOutRes <> 0) then
DosDir ($3B, S);
end
else
DosDir ($3B, S);
end;
end; end;
{$ASMMODE ATT}
procedure getdir(drivenr : byte;var dir : shortstring); procedure getdir(drivenr : byte;var dir : shortstring);
{Written by Michael Van Canneyt.} {Written by Michael Van Canneyt.}
@ -810,7 +881,10 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.1 2000-10-15 08:19:49 peter Revision 1.2 2000-10-15 20:43:10 hajny
* ChDir correction, unit name changed
Revision 1.1 2000/10/15 08:19:49 peter
* system unit rename for 1.1 branch * system unit rename for 1.1 branch
Revision 1.3 2000/09/29 21:49:41 jonas Revision 1.3 2000/09/29 21:49:41 jonas