paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-06 07:47:59 +02:00
Code Issues Packages Projects Releases Wiki Activity

human68k: implemented do_chdir

Browse Source
This commit is contained in:
Karoly Balogh 2023-12-06 04:28:24 +01:00
parent 09397bd542
commit 34519c67a1
2 changed files with 33 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
rtl/human68k/h68kdos.inc
View File

@ -106,6 +106,7 @@ const
SEEK_FROM_END = 2;
procedure h68kdos_exit; noreturn; syscall $ff00;
function h68kdos_chgdrv(newdrv: word): longint; syscall $ff0e;
function h68kdos_curdrv: longint; syscall $ff17;
function h68kdos_gettim2: longint; syscall $ff27;
function h68kdos_mkdir(name: pchar): longint; syscall $ff39;

32
rtl/human68k/sysdir.inc
View File

@ -50,7 +50,39 @@ end;
procedure do_ChDir(const s: rawbytestring);
var
ps: rawbytestring;
len: longint;
curdrive: word;
newdrive: word;
dosResult: longint;
begin
ps:=s;
DoDirSeparators(ps);
len:=Length(ps);
{ first, handle drive changes }
if (len>=2) and (ps[2]=':') then
begin
curdrive:=h68kdos_curdrv;
newdrive:=(ord(ps[1]) and (not 32))-ord('A');
if (newdrive <> curdrive) then
begin
dosResult:=h68kdos_chgdrv(newdrive);
if dosResult <= newdrive then
begin
Error2InOutRes(DOSE_ILGDRV);
exit;
end;
end;
if len=2 then
exit;
end;
{ do normal setpath }
dosResult:=h68kdos_chdir(PAnsiChar(ps));
if dosResult < 0 then
Error2InOutRes(dosResult);
end;