Merged revisions 1792-1794 via svnmerge from

http://svn.freepascal.org/svn/fpc/trunk

........
r1792 | florian | 2005-11-20 13:23:54 +0100 (So, 20 Nov 2005) | 2 lines

* made generic basic file handling 64 bit

........
r1793 | florian | 2005-11-20 16:50:06 +0100 (So, 20 Nov 2005) | 2 lines

+ 64 bit fs support

........
r1794 | tom_at_work | 2005-11-20 19:14:23 +0100 (So, 20 Nov 2005) | 1 line

* fixes for successful cycle on 64 bit systems after 64 bit FS changes
........

git-svn-id: branches/fixes_2_0@1915 -

fcl/db/ddg_ds.pp

@@ -361,13 +361,13 @@ begin
   BlockWrite(FDataFile, PDDGData(Buffer)^, 1);
   if DoAppend then
   begin
-    FIndexList.Add(Pointer(FileSize(FDataFile) - 1));
+    FIndexList.Add(Pointer(PtrInt(FileSize(FDataFile) - 1)));
     InternalLast;
   end
   else begin
     if FRecordPos = -1 then RecPos := 0
     else RecPos := FRecordPos;
-    FIndexList.Insert(RecPos, Pointer(FileSize(FDataFile) - 1));
+    FIndexList.Insert(RecPos, Pointer(PtrInt(FileSize(FDataFile) - 1)));
   end;
   FIndexList.SaveToFile(FIdxName);
 end;

rtl/inc/file.inc

@@ -123,7 +123,7 @@ Begin
 End;
 
 
-Procedure BlockWrite(Var f:File;Const Buf;Count:Longint;var Result:Longint);[IOCheck];
+Procedure BlockWrite(Var f:File;Const Buf;Count:Int64;var Result:Int64);[IOCheck];
 {
   Write Count records from Buf to file f, return written records in result
 }
@@ -141,57 +141,65 @@ Begin
 End;
 
 
+Procedure BlockWrite(Var f:File;Const Buf;Count:Longint;var Result:Longint);[IOCheck];
+{
+  Write Count records from Buf to file f, return written records in result
+}
+var
+  l : Int64;
+Begin
+  BlockWrite(f,Buf,Count,l);
+  Result:=longint(l);
+End;
+
+
 Procedure BlockWrite(Var f:File;Const Buf;Count:Word;var Result:Word);[IOCheck];
 {
   Write Count records from Buf to file f, return written records in Result
 }
 var
-  l : longint;
+  l : Int64;
 Begin
   BlockWrite(f,Buf,Count,l);
   Result:=word(l);
 End;
 
-
 Procedure BlockWrite(Var f:File;Const Buf;Count:Cardinal;var Result:Cardinal);[IOCheck];
 {
   Write Count records from Buf to file f, return written records in Result
 }
 var
-  l : longint;
+  l : Int64;
 Begin
   BlockWrite(f,Buf,Count,l);
   Result:=l;
 End;
 
-
 Procedure BlockWrite(Var f:File;Const Buf;Count:Word;var Result:Integer);[IOCheck];
 {
   Write Count records from Buf to file f, return written records in Result
 }
 var
-  l : longint;
+  l : Int64;
 Begin
   BlockWrite(f,Buf,Count,l);
   Result:=integer(l);
 End;
 
-
 Procedure BlockWrite(Var f:File;Const Buf;Count:Longint);[IOCheck];
 {
   Write Count records from Buf to file f, if none a Read and Count>0 then
   InOutRes is set
 }
 var
-  Result : Longint;
+  Result : Int64;
 Begin
   BlockWrite(f,Buf,Count,Result);
   If (InOutRes=0) and (Result<Count) and (Count>0) Then
    InOutRes:=101;
 End;
 
-
-Procedure BlockRead(var f:File;var Buf;Count:Longint;var Result:Longint);[IOCheck];
+Procedure BlockRead(var f:File;var Buf;Count:Int64;var Result:Int64);[IOCheck];
 {
   Read Count records from file f ro Buf, return number of read records in
   Result
@@ -209,6 +217,17 @@ Begin
   end;
 End;
 
+Procedure BlockRead(var f:File;var Buf;Count:Longint;var Result:Longint);[IOCheck];
+{
+  Read Count records from file f ro Buf, return number of read records in
+  Result
+}
+var
+  l : int64;
+Begin
+  BlockRead(f,Buf,Count,l);
+  Result:=longint(l);
+End;
 
 Procedure BlockRead(var f:File;var Buf;count:Word;var Result:Word);[IOCheck];
 {
@@ -216,46 +235,43 @@ Procedure BlockRead(var f:File;var Buf;count:Word;var Result:Word);[IOCheck];
   Result
 }
 var
-  l : longint;
+  l : int64;
 Begin
   BlockRead(f,Buf,Count,l);
   Result:=word(l);
 End;
 
-
 Procedure BlockRead(var f:File;var Buf;count:Cardinal;var Result:Cardinal);[IOCheck];
 {
   Read Count records from file f to Buf, return number of read records in
   Result
 }
 var
-  l : longint;
+  l : int64;
 Begin
   BlockRead(f,Buf,Count,l);
   Result:=l;
 End;
 
-
 Procedure BlockRead(var f:File;var Buf;count:Word;var Result:Integer);[IOCheck];
 {
   Read Count records from file f to Buf, return number of read records in
   Result
 }
 var
-  l : longint;
+  l : int64;
 Begin
   BlockRead(f,Buf,Count,l);
   Result:=integer(l);
 End;
 
-
-Procedure BlockRead(Var f:File;Var Buf;Count:Longint);[IOCheck];
+Procedure BlockRead(Var f:File;Var Buf;Count:Int64);[IOCheck];
 {
   Read Count records from file f to Buf, if none are read and Count>0 then
   InOutRes is set
 }
 var
-  Result : Longint;
+  Result : int64;
 Begin
   BlockRead(f,Buf,Count,Result);
   If (InOutRes=0) and (Result<Count) and (Count>0) Then
@@ -263,7 +279,7 @@ Begin
 End;
 
 
-Function FilePos(var f:File):Longint;[IOCheck];
+Function FilePos(var f:File):Int64;[IOCheck];
 {
   Return current Position In file f in records
 }
@@ -280,7 +296,7 @@ Begin
 End;
 
 
-Function FileSize(var f:File):Longint;[IOCheck];
+Function FileSize(var f:File):Int64;[IOCheck];
 {
   Return the size of file f in records
 }
@@ -315,7 +331,7 @@ Begin
 End;
 
 
-Procedure Seek(var f:File;Pos:Longint);[IOCheck];
+Procedure Seek(var f:File;Pos:Int64);[IOCheck];
 {
   Goto record Pos in file f
 }
@@ -329,7 +345,6 @@ Begin
   end;
 End;
 
-
 Procedure Truncate(Var f:File);[IOCheck];
 {
   Truncate/Cut file f at the current record Position

rtl/inc/systemh.inc

@@ -511,19 +511,21 @@ Procedure Rewrite(Var f:File);
 Procedure Reset(Var f:File;l:Longint);
 Procedure Reset(Var f:File);
 Procedure Close(Var f:File);
+Procedure BlockWrite(Var f:File;Const Buf;Count:Int64;Var Result:Int64);
 Procedure BlockWrite(Var f:File;Const Buf;Count:Longint;Var Result:Longint);
 Procedure BlockWrite(Var f:File;Const Buf;Count:Cardinal;var Result:Cardinal);
 Procedure BlockWrite(Var f:File;Const Buf;Count:Word;Var Result:Word);
 Procedure BlockWrite(Var f:File;Const Buf;Count:Word;Var Result:Integer);
 Procedure BlockWrite(Var f:File;Const Buf;Count:Longint);
+Procedure BlockRead(Var f:File;Var Buf;count:Int64;Var Result:Int64);
 Procedure BlockRead(Var f:File;Var Buf;count:Longint;Var Result:Longint);
 Procedure BlockRead(Var f:File;Var Buf;count:Cardinal;Var Result:Cardinal);
 Procedure BlockRead(Var f:File;Var Buf;count:Word;Var Result:Word);
 Procedure BlockRead(Var f:File;Var Buf;count:Word;Var Result:Integer);
-Procedure BlockRead(Var f:File;Var Buf;count:Longint);
-Function  FilePos(Var f:File):Longint;
-Function  FileSize(Var f:File):Longint;
-Procedure Seek(Var f:File;Pos:Longint);
+Procedure BlockRead(Var f:File;Var Buf;count:Int64);
+Function  FilePos(Var f:File):Int64;
+Function  FileSize(Var f:File):Int64;
+Procedure Seek(Var f:File;Pos:Int64);
 Function  EOF(Var f:File):Boolean;
 Procedure Erase(Var f:File);
 Procedure Rename(Var f:File;const s:string);

rtl/inc/text.inc

@@ -85,7 +85,7 @@ Begin
     tlbsLF: TextRec(t).LineEnd := #10;
     tlbsCRLF: TextRec(t).LineEnd := #13#10;
     tlbsCR: TextRec(t).LineEnd := #13;
-  End;  
+  End;
   Move(s[1],TextRec(t).Name,Length(s));
 End;
 
@@ -267,7 +267,9 @@ End;
 
 Function SeekEof (Var t : Text) : Boolean;
 var
-  oldfilepos, oldbufpos, oldbufend, reads: longint;
+  oldfilepos : Int64;
+  oldbufpos, oldbufend : SizeInt;
+  reads: longint;
   isdevice: boolean;
 Begin
   If (InOutRes<>0) then
@@ -310,13 +312,14 @@ Begin
         end;
      end;
     case TextRec(t).Bufptr^[TextRec(t).BufPos] of
-         #26 : if CtrlZMarksEOF then
-                begin
-                 SeekEof := true;
-                 break;
-                end;
-     #10,#13,
-      #9,' ' : ;
+      #26 :
+        if CtrlZMarksEOF then
+          begin
+            SeekEof := true;
+            break;
+          end;
+     #10,#13,#9,' ' :
+       ;
     else
      begin
        SeekEof := false;
@@ -420,8 +423,7 @@ Begin
 End;
 
 
-
-Procedure SetTextBuf(Var F : Text; Var Buf; Size : Longint);
+Procedure SetTextBuf(Var F : Text; Var Buf; Size : SizeInt);
 Begin
   TextRec(f).BufPtr:=@Buf;
   TextRec(f).BufSize:=Size;
@@ -451,11 +453,11 @@ end;
                                Write(Ln)
 *****************************************************************************}
 
-Procedure fpc_WriteBuffer(var f:Text;const b;len:longint);[Public,Alias:'FPC_WRITEBUFFER'];
+Procedure fpc_WriteBuffer(var f:Text;const b;len:SizeInt);[Public,Alias:'FPC_WRITEBUFFER'];
 var
   p   : pchar;
   left,
-  idx : longint;
+  idx : SizeInt;
 begin
   p:=pchar(@b);
   idx:=0;
@@ -536,7 +538,6 @@ End;
 { provide local access to write_str }
 procedure Write_Str(Len : Longint;var f : Text;const s : String); iocheck; [external name 'FPC_WRITE_TEXT_SHORTSTR'];
 
-
 Procedure fpc_Write_Text_Pchar_as_Array(Len : Longint;var f : Text;const s : array of char); iocheck; [Public,Alias:'FPC_WRITE_TEXT_PCHAR_AS_ARRAY']; compilerproc;
 var
   ArrayLen : longint;
@@ -630,6 +631,7 @@ begin
   end;
 end;
 
+
 Procedure fpc_Write_Text_SInt(Len : Longint;var t : Text;l : ValSInt); iocheck; [Public,Alias:'FPC_WRITE_TEXT_SINT']; compilerproc;
 var
   s : String;
@@ -958,7 +960,7 @@ End;
 
 Procedure fpc_Read_Text_AnsiStr(var f : Text;out s : AnsiString); iocheck; [Public,Alias:'FPC_READ_TEXT_ANSISTR']; compilerproc;
 var
-  slen,len : longint;
+  slen,len : SizeInt;
 Begin
   slen:=0;
   Repeat

rtl/win32/sysfile.inc

@@ -98,45 +98,78 @@ begin
 end;
 
 
-function do_filepos(handle : thandle) : longint;
+function do_filepos(handle : thandle) : Int64;
 var
   l:longint;
 begin
-  l:=SetFilePointer(handle,0,nil,FILE_CURRENT);
-  if l=-1 then
-   begin
-    l:=0;
-    errno:=GetLastError;
-    Errno2InoutRes;
-   end;
-  do_filepos:=l;
+  if assigned(SetFilePointerEx) then
+    begin
+      if not(SetFilePointerEx(handle,0,@result,FILE_CURRENT)) then
+        begin
+          errno:=GetLastError;
+          Errno2InoutRes;
+        end;
+    end
+  else
+    begin
+      l:=SetFilePointer(handle,0,nil,FILE_CURRENT);
+      if l=-1 then
+       begin
+        l:=0;
+        errno:=GetLastError;
+        Errno2InoutRes;
+       end;
+      do_filepos:=l;
+    end;
 end;
 
 
-procedure do_seek(handle:thandle;pos : longint);
+procedure do_seek(handle:thandle;pos : Int64);
 begin
-  if SetFilePointer(handle,pos,nil,FILE_BEGIN)=-1 then
-   Begin
-    errno:=GetLastError;
-    Errno2InoutRes;
-   end;
+  if assigned(SetFilePointerEx) then
+    begin
+      if not(SetFilePointerEx(handle,pos,nil,FILE_BEGIN)) then
+        begin
+          errno:=GetLastError;
+          Errno2InoutRes;
+        end;
+    end
+  else
+    begin
+      if SetFilePointer(handle,pos,nil,FILE_BEGIN)=-1 then
+       Begin
+        errno:=GetLastError;
+        Errno2InoutRes;
+       end;
+    end;
 end;
 
 
-function do_seekend(handle:thandle):longint;
+function do_seekend(handle:thandle):Int64;
 begin
-  do_seekend:=SetFilePointer(handle,0,nil,FILE_END);
-  if do_seekend=-1 then
+  if assigned(SetFilePointerEx) then
     begin
-      errno:=GetLastError;
-      Errno2InoutRes;
+      if not(SetFilePointerEx(handle,0,@result,FILE_END)) then
+        begin
+          errno:=GetLastError;
+          Errno2InoutRes;
+        end;
+    end
+  else
+    begin
+      do_seekend:=SetFilePointer(handle,0,nil,FILE_END);
+      if do_seekend=-1 then
+        begin
+          errno:=GetLastError;
+          Errno2InoutRes;
+        end;
     end;
 end;
 
 
-function do_filesize(handle : thandle) : longint;
+function do_filesize(handle : thandle) : Int64;
 var
-  aktfilepos : longint;
+  aktfilepos : Int64;
 begin
   aktfilepos:=do_filepos(handle);
   do_filesize:=do_seekend(handle);
@@ -144,7 +177,7 @@ begin
 end;
 
 
-procedure do_truncate (handle:thandle;pos:longint);
+procedure do_truncate (handle:thandle;pos:Int64);
 begin
    do_seek(handle,pos);
    if not(SetEndOfFile(handle)) then

rtl/win32/sysos.inc

@@ -250,6 +250,27 @@ var
    function GetCurrentDirectory(bufsize : longint;name : pchar) : longbool;
      stdcall;external 'kernel32' name 'GetCurrentDirectoryA';
 
+   function LoadLibrary(lpLibFileName:pchar):THandle; stdcall; external KernelDLL name 'LoadLibraryA';
+   function FreeLibrary(hLibModule:THandle):ByteBool; stdcall; external KernelDLL name 'FreeLibrary';
+   function GetProcAddress(hModule:THandle; lpProcName:pchar):pointer; stdcall; external KernelDLL name 'GetProcAddress';
+
+   var
+     SetFilePointerEx : function(hFile : THandle;
+       liDistanceToMove : int64;lpNewFilePointer : pint64;
+       dwMoveMethod : DWord) : ByteBool;stdcall;
+
+  procedure SetupProcVars;
+    var
+      hinstLib : THandle;
+    begin
+      SetFilePointerEx:=nil;
+      hinstLib:=LoadLibrary(KernelDLL);
+      if hinstLib<>0 then
+        begin
+          pointer(SetFilePointerEx):=GetProcAddress(hinstLib,'SetFilePointerEx');
+          FreeLibrary(hinstLib);
+        end;
+    end;
 
 
    Procedure Errno2InOutRes;

rtl/win32/system.pp

@@ -1,6 +1,6 @@
 {
     This file is part of the Free Pascal run time library.
-    Copyright (c) 1999-2000 by Florian Klaempfl and Pavel Ozerski
+    Copyright (c) 1999-2005 by Florian Klaempfl and Pavel Ozerski
     member of the Free Pascal development team.
 
     FPC Pascal system unit for the Win32 API.
@@ -170,8 +170,9 @@ var
       { the arg. is still present!                     }
       sysreallocmem(argv[idx],len+1);
     end;
-
+    
 begin
+  SetupProcVars;
   { create commandline, it starts with the executed filename which is argv[0] }
   { Win32 passes the command NOT via the args, but via getmodulefilename}
   count:=0;

rtl/win32/wininc/func.inc

@@ -57,7 +57,8 @@ function LockResource(hResData:HGLOBAL):LPVOID; external 'kernel32' name 'LockRe
 {$ifdef Unknown_functions}
 { WARNING: function not found !!}
 function WinMain(hInstance:HINST; hPrevInstance:HINST; lpCmdLine:LPSTR; nShowCmd:longint):longint; external External_library name 'WinMain';
-{$endif Unknown_functions}function FreeLibrary(hLibModule:HINST):WINBOOL; external 'kernel32' name 'FreeLibrary';
+{$endif Unknown_functions}
+function FreeLibrary(hLibModule:HINST):WINBOOL; external 'kernel32' name 'FreeLibrary';
 procedure FreeLibraryAndExitThread(hLibModule:HMODULE; dwExitCode:DWORD); external 'kernel32' name 'FreeLibraryAndExitThread';
 function DisableThreadLibraryCalls(hLibModule:HMODULE):WINBOOL; external 'kernel32' name 'DisableThreadLibraryCalls';
 function GetProcAddress(hModule:HINST; lpProcName:LPCSTR):FARPROC; external 'kernel32' name 'GetProcAddress';