+ gadzillion amount of fixes for sysutils

+ changed graphics.move() to gfxMove() to avoid some conflicts

git-svn-id: trunk@5979 -

rtl/morphos/graphics.pas

@@ -2298,7 +2298,7 @@ SysCall GfxBase 228;
 procedure SetRast(rp : pRastPort location 'a1'; pen : CARDINAL location 'd0');
 SysCall GfxBase 234;
 
-procedure Move(rp : pRastPort location 'a1'; x : LongInt location 'd0'; y : LongInt location 'd1');
+procedure gfxMove(rp : pRastPort location 'a1'; x : LongInt location 'd0'; y : LongInt location 'd1');
 SysCall GfxBase 240;
 
 procedure Draw(rp : pRastPort location 'a1'; x : LongInt location 'd0'; y : LongInt location 'd1');

rtl/morphos/sysutils.pp

@@ -1,7 +1,6 @@
 {
-
     This file is part of the Free Pascal run time library.
-    Copyright (c) 2004 by Karoly Balogh
+    Copyright (c) 2004-2006 by Karoly Balogh
 
     Sysutils unit for MorphOS
 
@@ -63,6 +62,39 @@ var
   MOS_fileList: Pointer; external name 'MOS_FILELIST';
 
 
+function dosLock(const name: String;
+                 accessmode: Longint) : LongInt;
+var
+  buffer: array[0..255] of Char;
+begin
+  move(name[1],buffer,length(name));
+  buffer[length(name)]:=#0;
+  dosLock:=Lock(buffer,accessmode);
+end;
+
+
+function AmigaFileDateToDateTime(aDate: TDateStamp; out success: boolean): TDateTime;
+var
+  tmpSecs: DWord;
+  tmpDate: TDateTime;
+  tmpTime: TDateTime; 
+  clockData: TClockData;
+begin
+  with aDate do
+    tmpSecs:=(ds_Days * (24 * 60 * 60)) + (ds_Minute * 60) + (ds_Tick div TICKS_PER_SECOND);
+
+  Amiga2Date(tmpSecs,@clockData);
+{$WARNING TODO: implement msec values, if possible}
+  with clockData do begin
+     success:=TryEncodeDate(year,month,mday,tmpDate) and
+              TryEncodeTime(hour,min,sec,0,tmpTime);
+  end;
+
+  result:=ComposeDateTime(tmpDate,tmpTime);
+end;
+
+
+
 {****************************************************************************
                               File Functions
 ****************************************************************************}
@@ -90,6 +122,7 @@ end;
 
 function FileGetDate(Handle: LongInt) : LongInt;
 begin
+  {$WARNING filegetdate call is dummy}
 end;
 
 
@@ -211,122 +244,131 @@ end;
 (****** end of non portable routines ******)
 
 
-Function FileAge (Const FileName : String): Longint;
+function FileAge (const FileName : String): Longint;
+var
+  tmpName: String;
+  tmpLock: Longint;
+  tmpFIB : PFileInfoBlock;
+  tmpDateTime: TDateTime;
+  validFile: boolean;
 
-var F: file;
-    Time: longint;
 begin
-   Assign(F,FileName);
+  validFile:=false;
-   dos.GetFTime(F,Time);
+  tmpName := PathConv(FileName);
-   { Warning this is not compatible with standard routines
+  tmpLock := dosLock(tmpName, SHARED_LOCK);
-     since Double are not supported on m68k by default!
-   }
-   FileAge:=Time;
-end;
 
-
+  if (tmpLock <> 0) then begin
-Function FileExists (Const FileName : String) : Boolean;
+    new(tmpFIB);
-Var
+    if Examine(tmpLock,tmpFIB) then begin
- F: File;
+      tmpDateTime:=AmigaFileDateToDateTime(tmpFIB^.fib_Date,validFile);
- OldMode : Byte;
-Begin
-  OldMode := FileMode;
-  FileMode := fmOpenRead;
-  Assign(F,FileName);
-  Reset(F,1);
-  FileMode := OldMode;
-  If IOResult <> 0 then
-    FileExists := FALSE
-  else
-    Begin
-      FileExists := TRUE;
-      Close(F);
     end;
+    Unlock(tmpLock);
+    dispose(tmpFIB);
+  end;
+
+  if validFile then
+    result:=DateTimeToFileDate(tmpDateTime)
+  else
+    result:=-1;   
 end;
 
-type
-  PDOSSearchRec = ^SearchRec;
 
-Function FindFirst (Const Path : String; Attr : Longint; Out Rslt : TSearchRec) : Longint;
+function FileExists (const FileName : String) : Boolean;
-Const
-  faSpecial = faHidden or faSysFile or faVolumeID or faDirectory;
 var
-  p : pDOSSearchRec;
+  tmpName: String;
-  dosattr: word;
+  tmpLock: LongInt;
-  DT: Datetime;
+  tmpFIB : PFileInfoBlock;
+
 begin
- dosattr:=0;
+  result:=false;
- if Attr and faHidden <> 0 then
+  tmpName := PathConv(FileName);
-   dosattr := dosattr or Hidden;
+  tmpLock := dosLock(tmpName, SHARED_LOCK);
- if Attr and faSysFile <> 0 then
+
-   dosattr := dosattr or SysFile;
+  if (tmpLock <> 0) then begin
- if Attr and favolumeID <> 0 then
+    new(tmpFIB);
-   dosattr := dosattr or VolumeID;
+    if Examine(tmpLock,tmpFIB) and (tmpFIB^.fib_DirEntryType <= 0) then
- if Attr and faDirectory <> 0 then
+      result:=true;
-   dosattr := dosattr or Directory;
+    Unlock(tmpLock);
- New(p);
+    dispose(tmpFIB);
- Rslt.FindHandle :=  THandle(p);
+  end;
- dos.FindFirst(path,dosattr,p^);
- if DosError <> 0 then
-    begin
-      FindFirst := -1;
-    end
- else
-   begin
-     Rslt.Name := p^.Name;
-     { Not compatible with other platforms! }
-     Rslt.Time:=p^.Time;
-     Rslt.Attr := p^.Attr;
-     Rslt.ExcludeAttr := not p^.Attr;
-     Rslt.Size := p^.Size;
-     FindFirst := 0;
-   end;
 end;
 
 
-Function FindNext (Var Rslt : TSearchRec) : Longint;
+function FindFirst(const Path: String; Attr : Longint; out Rslt: TSearchRec): Longint;
 var
- p : pDOSSearchRec;
+  tmpStr: array[0..255] of Char;
- DT: Datetime;
+  Anchor: PAnchorPath;
+  tmpDateTime: TDateTime;
+  validDate: boolean;
 begin
-  p:= PDOsSearchRec(Rslt.FindHandle);
+  result:=-1; { We emulate Linux/Unix behaviour, and return -1 on errors. }
-  if not assigned(p) then
+
-     begin
+  tmpStr:=PathConv(path)+#0;
-       FindNext := -1;
+  Rslt.Name := tmpStr;
-       exit;
+  { "128" is Windows "NORMALFILE" attribute. Some buggy code depend on this... :( (KB) }
-     end;
+  Rslt.Attr := Attr or 128;
-  Dos.FindNext(p^);
+  { $1e = faHidden or faSysFile or faVolumeID or faDirectory }
- if DosError <> 0 then
+  Rslt.ExcludeAttr := (not Attr) and ($1e);
-    begin
+  Rslt.FindHandle  := 0;
-      FindNext := -1;
+
-    end
+  new(Anchor);
- else
+  FillChar(Anchor^,sizeof(TAnchorPath),#0);
-   begin
+
-     Rslt.Name := p^.Name;
+  if MatchFirst(@tmpStr,Anchor)<>0 then exit;
-     UnpackTime(p^.Time, DT);
+  Rslt.FindHandle := longint(Anchor);
-     { Warning: Not compatible with other platforms }
+
-     Rslt.time := p^.Time;
+  with Anchor^.ap_Info do begin
-     Rslt.Attr := p^.Attr;
+    Rslt.Size := fib_Size;
-     Rslt.ExcludeAttr := not p^.Attr;
+    Rslt.Time := DateTimeToFileDate(AmigaFileDateToDateTime(fib_Date,validDate));
-     Rslt.Size := p^.Size;
+    if not validDate then exit;
-     FindNext := 0;
+
-   end;
+    if fib_DirEntryType > 0 then Rslt.Attr:=Rslt.Attr or faDirectory;
+    if ((fib_Protection and FIBF_READ) <> 0) and
+       ((fib_Protection and FIBF_WRITE) = 0) then Rslt.Attr:=Rslt.Attr or faReadOnly;
+
+    result:=0; { Return zero if everything went OK }
+  end;
 end;
 
-Procedure FindClose (Var F : TSearchrec);
-Var
-  p : PDOSSearchRec;
 
+function FindNext (var Rslt : TSearchRec): Longint;
+var
+  Anchor: PAnchorPath;
+  validDate: boolean;
 begin
-  p:=PDOSSearchRec(f.FindHandle);
+  result:=-1;
-  if not assigned(p) then
+
-       exit;
+  Anchor:=PAnchorPath(Rslt.FindHandle);
-  Dos.FindClose(p^);
+  if not assigned(Anchor) then exit;
-  if assigned(p) then
+  if MatchNext(Anchor) <> 0 then exit;
-     Dispose(p);
+
-  f.FindHandle := THandle(nil);
+  with Anchor^.ap_Info do begin
+    Rslt.Size := fib_Size;
+    Rslt.Time := DateTimeToFileDate(AmigaFileDateToDateTime(fib_Date,validDate));
+    if not validDate then exit;
+
+    if fib_DirEntryType > 0 then Rslt.Attr:=Rslt.Attr or faDirectory;
+    if ((fib_Protection and FIBF_READ) <> 0) and
+       ((fib_Protection and FIBF_WRITE) = 0) then Rslt.Attr:=Rslt.Attr or faReadOnly;
+
+    result:=0; { Return zero if everything went OK }
+  end;
 end;
 
+
+procedure FindClose(var f: TSearchRec);
+var
+  Anchor: PAnchorPath;
+begin
+  Anchor:=PAnchorPath(f.FindHandle);
+  if not assigned(Anchor) then exit;
+  MatchEnd(Anchor);
+  Dispose(Anchor);
+end;
+
+
+(****** end of non portable routines ******)
+
 Function FileGetAttr (Const FileName : String) : Longint;
 var
  F: file;
@@ -403,8 +445,7 @@ Begin
   DiskSize := dos.DiskSize(Drive);
 End;
 
-
+function GetCurrentDir : String;
-Function GetCurrentDir : String;
 begin
   GetDir (0,Result);
 end;
@@ -412,44 +453,42 @@ end;
 
 Function SetCurrentDir (Const NewDir : String) : Boolean;
 begin
-   ChDir(NewDir);
+  ChDir(NewDir);
   result := (IOResult = 0);
 end;
 
 
 Function CreateDir (Const NewDir : String) : Boolean;
 begin
-   MkDir(NewDir);
+  MkDir(NewDir);
   result := (IOResult = 0);
 end;
 
 
 Function RemoveDir (Const Dir : String) : Boolean;
 begin
-   RmDir(Dir);
+  RmDir(Dir);
   result := (IOResult = 0);
 end;
 
 
 function DirectoryExists(const Directory: string): Boolean;
 var
-  tmpStr : array[0..255] of Char;
+  tmpStr : String;
   tmpLock: LongInt;
   FIB    : PFileInfoBlock;
 begin
-  DirectoryExists:=False;
+  result:=false;
-  If (Directory='') or (InOutRes<>0) then exit;
+  if (Directory='') or (InOutRes<>0) then exit;
-  tmpStr:=PathConv(Directory)+#0;
+  tmpStr:=PathConv(Directory);
-  tmpLock:=0;
 
-  tmpLock:=Lock(@tmpStr,SHARED_LOCK);
+  tmpLock:=dosLock(tmpStr,SHARED_LOCK);
   if tmpLock=0 then exit;
 
   FIB:=nil; new(FIB);
 
-  if (Examine(tmpLock,FIB)=True) and (FIB^.fib_DirEntryType>0) then begin
+  if (Examine(tmpLock,FIB)=True) and (FIB^.fib_DirEntryType>0) then
-    DirectoryExists:=True;
+    result:=True;
-  end;
 
   if tmpLock<>0 then Unlock(tmpLock);
   if assigned(FIB) then dispose(FIB);
@@ -476,7 +515,7 @@ var
 begin
   dos.GetTime(SystemTime.Hour, SystemTime.Minute, SystemTime.Second,SystemTime.Millisecond);
   dos.GetDate(SystemTime.Year, SystemTime.Month, SystemTime.Day, DayOfWeek);
-end ;
+end;
 
 
 Procedure InitAnsi;