+ preparations for conditional 64-bit FS support

git-svn-id: trunk@3802 -

rtl/os2/sysfile.inc

@@ -80,6 +80,54 @@ begin
 {$endif}
 end;
 
+{$IFDEF FPC_FS64}
+function Do_FilePos (Handle: THandle): int64;
+var
+  PosActual: int64;
+begin
+  InOutRes := DosSetFilePtrL (Handle, 0, 1, PosActual);
+  Do_FilePos := PosActual;
+{$ifdef IODEBUG}
+  writeln('do_filepos: handle=', Handle, ', actual_pos=', PosActual, ', InOutRes=', InOutRes);
+{$endif}
+end;
+
+procedure Do_Seek (Handle: THandle; Pos: int64);
+var
+  PosActual: int64;
+begin
+  InOutRes:=DosSetFilePtrL(Handle, Pos, 0 {ZeroBased}, PosActual);
+{$ifdef IODEBUG}
+  writeln('do_seek: handle=', Handle, ', pos=', pos, ', actual_pos=', PosActual, ', InOutRes=', InOutRes);
+{$endif}
+end;
+
+function Do_SeekEnd (Handle: THandle): int64;
+var
+  PosActual: int64;
+begin
+  InOutRes := DosSetFilePtrL (Handle, 0, 2 {EndBased}, PosActual);
+  Do_SeekEnd := PosActual;
+{$ifdef IODEBUG}
+  writeln('do_seekend: handle=', Handle, ', actual_pos=', PosActual, ', InOutRes=', InOutRes);
+{$endif}
+end;
+
+function Do_FileSize (Handle: THandle): int64;
+var
+  AktFilePos: int64;
+begin
+  AktFilePos := Do_FilePos (Handle);
+  Do_FileSize := Do_SeekEnd (Handle);
+  Do_Seek (Handle, AktFilePos);
+end;
+
+procedure Do_Truncate (Handle: THandle; Pos: int64);
+begin
+  InOutRes := DosSetFileSizeL (Handle, Pos);
+  Do_SeekEnd (Handle);
+end;
+{$ELSE FPC_FS64}
 function do_filepos(handle:thandle): longint;
 var
   PosActual: cardinal;
@@ -125,6 +173,8 @@ begin
   InOutRes:=DosSetFileSize(Handle, Pos);
   do_seekend(handle);
 end;
+{$ENDIF FPC_FS64}
+
 
 const
     FileHandleCount: cardinal = 20;
@@ -219,12 +269,20 @@ begin
 
   Attrib:=32 {faArchive};
 
+{$IFDEF FPC_FS64}
+  InOutRes:=DosOpenL(p, FileRec(F).Handle, Action, 0, Attrib, OpenFlags, FM, nil);
+{$ELSE FPC_FS64}
   InOutRes:=DosOpen(p, FileRec(F).Handle, Action, 0, Attrib, OpenFlags, FM, nil);
+{$ENDIF FPC_FS64}
 
   // If too many open files try to set more file handles and open again
   if (InOutRes = 4) then
     if Increase_File_Handle_Count then
+{$IFDEF FPC_FS64}
+      InOutRes:=DosOpenL(p, FileRec(F).Handle, Action, 0, Attrib, OpenFlags, FM, nil);
+{$ELSE FPC_FS64}
       InOutRes:=DosOpen(p, FileRec(F).Handle, Action, 0, Attrib, OpenFlags, FM, nil);
+{$ENDIF FPC_FS64}
 
   If InOutRes<>0 then FileRec(F).Handle:=UnusedHandle;
 
@@ -255,8 +313,3 @@ begin
   if ht=1 then do_isdevice:=true;
 end;
 {$ASMMODE ATT}
-
-
-
-
-

rtl/os2/sysos.inc

@@ -23,6 +23,21 @@ begin
  GetProcessID := ProcessID;
 end;
 
+
+type
+  TSysDateTime=packed record
+    Hour,
+    Minute,
+    Second,
+    Sec100,
+    Day,
+    Month: byte;
+    Year: word;
+    TimeZone: smallint;
+    WeekDay: byte;
+  end;
+
+
 procedure DosGetInfoBlocks (PATIB: PPThreadInfoBlock;
                             PAPIB: PPProcessInfoBlock); cdecl;
                             external 'DOSCALLS' index 312;
@@ -31,6 +46,10 @@ function DosLoadModule (ObjName: PChar; ObjLen: cardinal; DLLName: PChar;
                                         var Handle: cardinal): cardinal; cdecl;
 external 'DOSCALLS' index 318;
 
+function DosQueryModuleHandle (DLLName: PChar; var Handle: THandle): cardinal;
+                                                                         cdecl;
+external 'DOSCALLS' index 319;
+
 function DosQueryProcAddr (Handle, Ordinal: cardinal; ProcName: PChar;
                                         var Address: pointer): cardinal; cdecl;
 external 'DOSCALLS' index 321;
@@ -102,22 +121,56 @@ function DosQueryModuleName (Handle: THandle; NameLen: cardinal; Name: PChar):
                                                                cardinal; cdecl;
     external 'DOSCALLS' index 320;
 
+function DosGetDateTime(var Buf:TSysDateTime): cardinal; cdecl;
+    external 'DOSCALLS' index 230;
+
 
 type
-  TSysDateTime=packed record
-    Hour,
-    Minute,
-    Second,
-    Sec100,
-    Day,
-    Month: byte;
-    Year: word;
-    TimeZone: smallint;
-    WeekDay: byte;
-  end;
+  TDosOpenL = function (FileName: PChar; var Handle: THandle;
+                        var Action: cardinal; InitSize: int64;
+                        Attrib, OpenFlags, FileMode: cardinal;
+                                                 EA: pointer): cardinal; cdecl;
 
-function DosGetDateTime(var Buf:TSysDateTime): cardinal; cdecl;
-    external 'DOSCALLS' index 230;
+  TDosSetFilePtrL = function (Handle: THandle; Pos: int64; Method: cardinal;
+                                        var PosActual: int64): cardinal; cdecl;
+
+  TDosSetFileSizeL = function (Handle: THandle; Size: int64): cardinal; cdecl;
+
+
+function DummyDosOpenL (FileName: PChar; var Handle: THandle;
+                        var Action: cardinal; InitSize: int64;
+                        Attrib, OpenFlags, FileMode: cardinal;
+                                                 EA: pointer): cardinal; cdecl;
+begin
+  DummyDosOpenL := DosOpen (FileName, Handle, Action, InitSize, Attrib,
+                                                      OpenFlags, FileMode, EA);
+end;
+
+
+function DummyDosSetFilePtrL (Handle: THandle; Pos: int64; Method: cardinal;
+                                        var PosActual: int64): cardinal; cdecl;
+var
+  PosAct0: cardinal;
+begin
+  DummyDosSetFilePtrL := DosSetFilePtr (Handle, Pos, Method, PosAct0);
+  PosActual := PosAct0;
+end;
+
+
+function DummyDosSetFileSizeL (Handle: THandle; Size: int64): cardinal; cdecl;
+begin
+  DummyDosSetFileSizeL := DosSetFileSize (Handle, Size);
+end;
+
+
+const
+  DosOpenL: TDosOpenL = @DummyDosOpenL;
+  DosSetFilePtrL: TDosSetFilePtrL = @DummyDosSetFilePtrL;
+  DosSetFileSizeL: TDosSetFileSizeL = @DummyDosSetFileSizeL;
+
+  OrdDosOpenL = 981;
+  OrdDosSetFilePtrL = 988;
+  OrdDosSetFileSizeL = 989;
 
    { converts an OS/2 error code to a TP compatible error }
    { code. Same thing exists under most other supported   }

rtl/os2/system.pas

@@ -134,6 +134,9 @@ var
 (* should be only changed at the beginning of the main thread if needed.   *)
   UseHighMem: boolean;
 
+const
+(* Are file sizes > 2 GB (64-bit) supported on the current system? *)
+  FSApi64: boolean = false;
 
 
 procedure SetDefaultOS2FileType (FType: ShortString);
@@ -696,6 +699,10 @@ var TIB: PThreadInfoBlock;
     RC: cardinal;
     ErrStr: string;
     P: pointer;
+    DosCallsHandle: THandle;
+
+const
+    DosCallsName: array [0..8] of char = 'DOSCALLS'#0;
 
 begin
     IsLibrary := FALSE;
@@ -735,6 +742,25 @@ begin
        from the high memory region before changing value of this variable. *)
     InitHeap;
 
+    if DosQueryModuleHandle (@DosCallsName [0], DosCallsHandle) = 0 then
+      begin
+        if DosQueryProcAddr (DosCallsHandle, OrdDosOpenL, nil, P) = 0 then
+          begin
+            DosOpenL := TDosOpenL (P);
+            if DosQueryProcAddr (DosCallsHandle, OrdDosSetFilePtrL, nil, P) = 0
+                                                                           then
+              begin
+                DosSetFilePtrL := TDosSetFilePtrL (P);
+                if DosQueryProcAddr (DosCallsHandle, OrdDosSetFileSizeL, nil,
+                                                                    P) = 0 then
+                  begin
+                    DosSetFileSizeL := TDosSetFileSizeL (P);
+                    FSApi64 := true;
+                  end;
+              end;
+          end;
+      end;
+
     { ... and exceptions }
     SysInitExceptions;