فهرست منبع

atari: implemented and fixed some bits in the system unit, tdir test passes now on TOS

git-svn-id: trunk@35196 -
Károly Balogh 8 سال پیش
والد
کامیت
3aecf60dff
2فایلهای تغییر یافته به همراه51 افزوده شده و 5 حذف شده
  1. 50 4
      rtl/atari/sysdir.inc
  2. 1 1
      rtl/atari/system.pp

+ 50 - 4
rtl/atari/sysdir.inc

@@ -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;

+ 1 - 1
rtl/atari/system.pp

@@ -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 = ';';