mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-07 21:28:03 +02:00
atari: implemented and fixed some bits in the system unit, tdir test passes now on TOS
git-svn-id: trunk@35196 -
This commit is contained in:
parent
1660634e7a
commit
3aecf60dff
@ -37,13 +37,13 @@ var
|
||||
begin
|
||||
ps:=s;
|
||||
DoDirSeparators(ps);
|
||||
if s='.' then
|
||||
if ps='.' then
|
||||
begin
|
||||
InOutRes:=16;
|
||||
exit;
|
||||
end;
|
||||
|
||||
dosResult:=gemdos_ddelete(pchar(s));
|
||||
dosResult:=gemdos_ddelete(pchar(ps));
|
||||
if dosResult < 0 then
|
||||
Error2InOutRes(dosResult);
|
||||
end;
|
||||
@ -52,19 +52,65 @@ end;
|
||||
procedure do_ChDir(const s: rawbytestring);
|
||||
var
|
||||
ps: rawbytestring;
|
||||
len: longint;
|
||||
drives: dword;
|
||||
curdrive: word;
|
||||
newdrive: word;
|
||||
dosResult: longint;
|
||||
begin
|
||||
ps:=s;
|
||||
DoDirSeparators(ps);
|
||||
len:=Length(ps);
|
||||
|
||||
{$WARNING Implement do_chdir}
|
||||
{ first, handle drive changes }
|
||||
if (len>=2) and (ps[2]=':') then
|
||||
begin
|
||||
curdrive:=gemdos_dgetdrv;
|
||||
newdrive:=(ord(ps[1]) and (not 32))-ord('A');
|
||||
if (newdrive <> curdrive) then
|
||||
begin
|
||||
{ verify if the drive we have to set actually exist.
|
||||
not doing so may corrupt TOS internal structures,
|
||||
according to docs. (KB) }
|
||||
drives:=gemdos_dsetdrv(curdrive);
|
||||
if (drives and (1 shl newdrive)) = 0 then
|
||||
begin
|
||||
InOutRes:=15;
|
||||
exit;
|
||||
end;
|
||||
gemdos_dsetdrv(newdrive);
|
||||
end;
|
||||
if len=2 then
|
||||
exit;
|
||||
end;
|
||||
{ do normal setpath }
|
||||
dosResult:=gemdos_dsetpath(pchar(ps));
|
||||
if dosResult < 0 then
|
||||
Error2InOutRes(dosResult);
|
||||
end;
|
||||
|
||||
|
||||
procedure do_GetDir (DriveNr: byte; var Dir: RawByteString);
|
||||
var
|
||||
dosResult: longint;
|
||||
pathbuf: array[0..259] of char;
|
||||
begin
|
||||
Dir := '';
|
||||
|
||||
{$WARNING Implement do_getdir}
|
||||
dosResult:=gemdos_dgetpath(@pathbuf[2],DriveNr);
|
||||
if dosResult < 0 then
|
||||
begin
|
||||
Error2InOutRes(dosResult);
|
||||
exit;
|
||||
end;
|
||||
|
||||
if DriveNr = 0 then
|
||||
DriveNr := gemdos_dgetdrv + 1;
|
||||
|
||||
{ return a full path, including drive }
|
||||
pathbuf[0]:=char(ord('A') + DriveNr - 1);
|
||||
pathbuf[1]:=DriveSeparator;
|
||||
|
||||
Dir:=pathbuf;
|
||||
SetCodePage(Dir,DefaultSystemCodePage,false);
|
||||
end;
|
||||
|
@ -34,7 +34,7 @@ const
|
||||
LineEnding = #13#10;
|
||||
LFNSupport = false;
|
||||
CtrlZMarksEOF: boolean = false; (* #26 not considered as end of file *)
|
||||
DirectorySeparator = '/';
|
||||
DirectorySeparator = '\';
|
||||
DriveSeparator = ':';
|
||||
ExtensionSeparator = '.';
|
||||
PathSeparator = ';';
|
||||
|
Loading…
Reference in New Issue
Block a user