mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-17 19:49:22 +02:00
+ dynamically loaded 64-bit FS calls made available outside unit System
git-svn-id: trunk@6723 -
This commit is contained in:
parent
ee539c3a94
commit
1740525027
@ -84,7 +84,7 @@ function Do_FilePos (Handle: THandle): int64;
|
|||||||
var
|
var
|
||||||
PosActual: int64;
|
PosActual: int64;
|
||||||
begin
|
begin
|
||||||
InOutRes := DosSetFilePtrL (Handle, 0, 1, PosActual);
|
InOutRes := Sys_DosSetFilePtrL (Handle, 0, 1, PosActual);
|
||||||
Do_FilePos := PosActual;
|
Do_FilePos := PosActual;
|
||||||
{$ifdef IODEBUG}
|
{$ifdef IODEBUG}
|
||||||
writeln('do_filepos: handle=', Handle, ', actual_pos=', PosActual, ', InOutRes=', InOutRes);
|
writeln('do_filepos: handle=', Handle, ', actual_pos=', PosActual, ', InOutRes=', InOutRes);
|
||||||
@ -95,7 +95,7 @@ procedure Do_Seek (Handle: THandle; Pos: int64);
|
|||||||
var
|
var
|
||||||
PosActual: int64;
|
PosActual: int64;
|
||||||
begin
|
begin
|
||||||
InOutRes:=DosSetFilePtrL(Handle, Pos, 0 {ZeroBased}, PosActual);
|
InOutRes:=Sys_DosSetFilePtrL(Handle, Pos, 0 {ZeroBased}, PosActual);
|
||||||
{$ifdef IODEBUG}
|
{$ifdef IODEBUG}
|
||||||
writeln('do_seek: handle=', Handle, ', pos=', pos, ', actual_pos=', PosActual, ', InOutRes=', InOutRes);
|
writeln('do_seek: handle=', Handle, ', pos=', pos, ', actual_pos=', PosActual, ', InOutRes=', InOutRes);
|
||||||
{$endif}
|
{$endif}
|
||||||
@ -105,7 +105,7 @@ function Do_SeekEnd (Handle: THandle): int64;
|
|||||||
var
|
var
|
||||||
PosActual: int64;
|
PosActual: int64;
|
||||||
begin
|
begin
|
||||||
InOutRes := DosSetFilePtrL (Handle, 0, 2 {EndBased}, PosActual);
|
InOutRes := Sys_DosSetFilePtrL (Handle, 0, 2 {EndBased}, PosActual);
|
||||||
Do_SeekEnd := PosActual;
|
Do_SeekEnd := PosActual;
|
||||||
{$ifdef IODEBUG}
|
{$ifdef IODEBUG}
|
||||||
writeln('do_seekend: handle=', Handle, ', actual_pos=', PosActual, ', InOutRes=', InOutRes);
|
writeln('do_seekend: handle=', Handle, ', actual_pos=', PosActual, ', InOutRes=', InOutRes);
|
||||||
@ -123,7 +123,7 @@ end;
|
|||||||
|
|
||||||
procedure Do_Truncate (Handle: THandle; Pos: int64);
|
procedure Do_Truncate (Handle: THandle; Pos: int64);
|
||||||
begin
|
begin
|
||||||
InOutRes := DosSetFileSizeL (Handle, Pos);
|
InOutRes := Sys_DosSetFileSizeL (Handle, Pos);
|
||||||
Do_SeekEnd (Handle);
|
Do_SeekEnd (Handle);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -221,12 +221,12 @@ begin
|
|||||||
|
|
||||||
Attrib:=32 {faArchive};
|
Attrib:=32 {faArchive};
|
||||||
|
|
||||||
InOutRes:=DosOpenL(p, FileRec(F).Handle, Action, 0, Attrib, OpenFlags, FM, nil);
|
InOutRes:=Sys_DosOpenL(p, FileRec(F).Handle, Action, 0, Attrib, OpenFlags, FM, nil);
|
||||||
|
|
||||||
// If too many open files try to set more file handles and open again
|
// If too many open files try to set more file handles and open again
|
||||||
if (InOutRes = 4) then
|
if (InOutRes = 4) then
|
||||||
if Increase_File_Handle_Count then
|
if Increase_File_Handle_Count then
|
||||||
InOutRes:=DosOpenL(p, FileRec(F).Handle, Action, 0, Attrib, OpenFlags, FM, nil);
|
InOutRes:=Sys_DosOpenL(p, FileRec(F).Handle, Action, 0, Attrib, OpenFlags, FM, nil);
|
||||||
|
|
||||||
If InOutRes<>0 then FileRec(F).Handle:=UnusedHandle;
|
If InOutRes<>0 then FileRec(F).Handle:=UnusedHandle;
|
||||||
|
|
||||||
|
@ -125,6 +125,8 @@ function DosGetDateTime(var Buf:TSysDateTime): cardinal; cdecl;
|
|||||||
external 'DOSCALLS' index 230;
|
external 'DOSCALLS' index 230;
|
||||||
|
|
||||||
|
|
||||||
|
{
|
||||||
|
Already declared in interface part:
|
||||||
type
|
type
|
||||||
TDosOpenL = function (FileName: PChar; var Handle: THandle;
|
TDosOpenL = function (FileName: PChar; var Handle: THandle;
|
||||||
var Action: cardinal; InitSize: int64;
|
var Action: cardinal; InitSize: int64;
|
||||||
@ -135,7 +137,7 @@ type
|
|||||||
var PosActual: int64): cardinal; cdecl;
|
var PosActual: int64): cardinal; cdecl;
|
||||||
|
|
||||||
TDosSetFileSizeL = function (Handle: THandle; Size: int64): cardinal; cdecl;
|
TDosSetFileSizeL = function (Handle: THandle; Size: int64): cardinal; cdecl;
|
||||||
|
}
|
||||||
|
|
||||||
function DummyDosOpenL (FileName: PChar; var Handle: THandle;
|
function DummyDosOpenL (FileName: PChar; var Handle: THandle;
|
||||||
var Action: cardinal; InitSize: int64;
|
var Action: cardinal; InitSize: int64;
|
||||||
@ -164,10 +166,6 @@ end;
|
|||||||
|
|
||||||
|
|
||||||
const
|
const
|
||||||
DosOpenL: TDosOpenL = @DummyDosOpenL;
|
|
||||||
DosSetFilePtrL: TDosSetFilePtrL = @DummyDosSetFilePtrL;
|
|
||||||
DosSetFileSizeL: TDosSetFileSizeL = @DummyDosSetFileSizeL;
|
|
||||||
|
|
||||||
OrdDosOpenL = 981;
|
OrdDosOpenL = 981;
|
||||||
OrdDosSetFilePtrL = 988;
|
OrdDosSetFilePtrL = 988;
|
||||||
OrdDosSetFileSizeL = 989;
|
OrdDosSetFileSizeL = 989;
|
||||||
|
@ -153,6 +153,33 @@ procedure SetDefaultOS2FileType (FType: ShortString);
|
|||||||
|
|
||||||
procedure SetDefaultOS2Creator (Creator: ShortString);
|
procedure SetDefaultOS2Creator (Creator: ShortString);
|
||||||
|
|
||||||
|
type
|
||||||
|
TDosOpenL = function (FileName: PChar; var Handle: THandle;
|
||||||
|
var Action: cardinal; InitSize: int64;
|
||||||
|
Attrib, OpenFlags, FileMode: cardinal;
|
||||||
|
EA: pointer): cardinal; cdecl;
|
||||||
|
|
||||||
|
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;
|
||||||
|
|
||||||
|
function DummyDosSetFilePtrL (Handle: THandle; Pos: int64; Method: cardinal;
|
||||||
|
var PosActual: int64): cardinal; cdecl;
|
||||||
|
|
||||||
|
function DummyDosSetFileSizeL (Handle: THandle; Size: int64): cardinal; cdecl;
|
||||||
|
|
||||||
|
|
||||||
|
const
|
||||||
|
Sys_DosOpenL: TDosOpenL = @DummyDosOpenL;
|
||||||
|
Sys_DosSetFilePtrL: TDosSetFilePtrL = @DummyDosSetFilePtrL;
|
||||||
|
Sys_DosSetFileSizeL: TDosSetFileSizeL = @DummyDosSetFileSizeL;
|
||||||
|
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
@ -750,15 +777,15 @@ begin
|
|||||||
begin
|
begin
|
||||||
if DosQueryProcAddr (DosCallsHandle, OrdDosOpenL, nil, P) = 0 then
|
if DosQueryProcAddr (DosCallsHandle, OrdDosOpenL, nil, P) = 0 then
|
||||||
begin
|
begin
|
||||||
DosOpenL := TDosOpenL (P);
|
Sys_DosOpenL := TDosOpenL (P);
|
||||||
if DosQueryProcAddr (DosCallsHandle, OrdDosSetFilePtrL, nil, P) = 0
|
if DosQueryProcAddr (DosCallsHandle, OrdDosSetFilePtrL, nil, P) = 0
|
||||||
then
|
then
|
||||||
begin
|
begin
|
||||||
DosSetFilePtrL := TDosSetFilePtrL (P);
|
Sys_DosSetFilePtrL := TDosSetFilePtrL (P);
|
||||||
if DosQueryProcAddr (DosCallsHandle, OrdDosSetFileSizeL, nil,
|
if DosQueryProcAddr (DosCallsHandle, OrdDosSetFileSizeL, nil,
|
||||||
P) = 0 then
|
P) = 0 then
|
||||||
begin
|
begin
|
||||||
DosSetFileSizeL := TDosSetFileSizeL (P);
|
Sys_DosSetFileSizeL := TDosSetFileSizeL (P);
|
||||||
FSApi64 := true;
|
FSApi64 := true;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
Loading…
Reference in New Issue
Block a user