All Projects FPC fpcprojects fpprofilerfpGUI Lazarus Packages PatchesLazarus CCR Mantis pas2js

View Issue Details

Jump to NotesJump to History
IDProjectCategoryView StatusDate SubmittedLast Update
0037456FPCCompilerpublic2020-07-31 12:482020-07-31 21:18
ReporterChris Rorden Assigned To 
PrioritynormalSeverityminorReproducibilityalways
Status newResolutionopen 
PlatformRyzen 3900XOSUbuntu 
Product Version3.2.0 
Summary0037456: Blockwrite limited to 2Gb
DescriptionThe overloaded function call
  procedure BlockWrite( var f: file; const Buf; Count: Int64; var Result: Int64);
uses Int64, so it suggests one can write huge files. However, in practice this function fails when the count nears the maximum for a 32-bit integer. Ideally, this function should handle large files (e.g. I am working with images from MorphoSource that are 6 Gb before I crop and interpolate them). Alternatively, the documentation should be updated to describe the limits. I also know people can adjust the blocksize, but this is not flexible (consider large vector where the number of elements are a prime number).

Steps To ReproduceThe following program demonstrates the error. It notes that 64-bit pointers are used, but fails to save a file that should (barely) fit into 32 bits:

SizeInt:8
Failed to save all data: wrote 2147479552 of 2147483647 bytes

------------------------------------------------

program saveimg;
{$mode objfpc}
{$H+}

//uses System;

type
 TUInt8s = array of uint8;
 
function SaveImg(fnm: string; img: TUInt8s): boolean;
var
  f: file;
  nImgBytes, nWritten: int64;
begin
  result := false;
  if fnm = '' then exit;
  nImgBytes := length(img);
  AssignFile(f, fnm);
  FileMode := 2;
  Rewrite(f, 1);
  Blockwrite(f,img[0],nImgBytes, nWritten);
  CloseFile(f);
  if (nImgBytes <> nWritten) then begin
     writeln('Failed to save all data: wrote ',nWritten,' of ', nImgBytes ,' bytes');
     exit;
  end;
  result := true;
end;

procedure MakeImg;
const
  kMaxInt32 = 2147483647;
var
  img: TUInt8s;
begin
  writeln('SizeInt:', sizeof(SizeInt));
  setlength(img, kMaxInt32 );
  SaveImg('big.img', img);
end;

begin
  MakeImg();
end.
TagsNo tags attached.
Fixed in Revision
FPCOldBugId
FPCTarget
Attached Files

Activities

Chris Rorden

2020-07-31 13:35

reporter   ~0124430

Here is a kludge to deal with writing larger files. It is unclear if this is a bug, or if the documentation need to be extended to describe the maximum count (which is not an intuitive value, slightly less than the maximum for a 32-bit signed integer.

function SaveImg(fnm: string; img: TUInt8s): boolean;
const
  kMaxBlockWrite = 1073741824;
var
  f: file;
  nImgBytes, nWritten, nBlock, nOK: int64;
begin
  result := false;
  if fnm = '' then exit;
  nImgBytes := length(img);
  AssignFile(f, fnm);
  FileMode := 2;
  Rewrite(f, 1);
  nWritten := 0;
  while (nWritten < nImgBytes) do begin
     nBlock := min(kMaxBlockWrite, nImgBytes - nWritten);
     Blockwrite(f,img[nWritten],nBlock, nOK);
     if nOK <> nBlock then
        break;
     nWritten += nBlock;
  end;
  CloseFile(f);
  if (nImgBytes <> nWritten) then begin
    writeln('Failed to save all data: wrote ',nWritten,' of ', nImgBytes ,' bytes');
    exit;
  end;
  result := true;
end;

Marģers

2020-07-31 18:03

reporter   ~0124438

From TP help:
Result is an optional parameter. If the entire block was transferred, Result will be equal to Count on return. Otherwise, if Result is less than Count, the disk became full before the transfer was completed. In that case, if the file's record size is greater than 1, Result return the number of complete records written.

It's look like to me as a bug. Fpc should be able write all data in buffer as long there is free disk space.

Chris Rorden

2020-07-31 18:54

reporter   ~0124440

Last edited: 2020-07-31 18:55

View 2 revisions

 So BlockWrite uses int64, which calls Do_Write which uses Longint which calls FpWrite which uses TSize
It seems to me that the type of the Do_Write() "Len" as well as its result should match that of FpWrite(), which I presume is machine dependent.

https://raw.githubusercontent.com/graemeg/freepascal/2e3d36f4c0a3d63de8a30c8baec047ff87dc17ba/rtl/inc/file.inc
rtl/inc/file.inc

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
}
Begin
  Result:=0;
  If InOutRes <> 0 then
   exit;
  case FileRec(f).Mode of
    fmInOut,fmOutput :
      Result:=Do_Write(FileRec(f).Handle,@Buf,Count*FileRec(f).RecSize)
        div FileRec(f).RecSize;
    fmInPut: inOutRes := 105;
    else InOutRes:=103;
  end;
End;

//https://github.com/graemeg/freepascal/blob/2e3d36f4c0a3d63de8a30c8baec047ff87dc17ba/rtl/unix/sysfile.inc
rtl/unix/sysfile.inc

Function Do_Write(Handle:thandle;Addr:Pointer;Len:Longint):longint;

var j : cint;
Begin
  repeat
    Do_Write:=Fpwrite(Handle,addr,len);
    j:=geterrno;
  until (do_write<>-1) or ((j<>ESysEINTR) and (j<>ESysEAgain));
  If Do_Write<0 Then
   Begin
    Errno2InOutRes;
    Do_Write:=0;
   End
  else
   InOutRes:=0;
End;

//https://github.com/graemeg/freepascal/blob/2e3d36f4c0a3d63de8a30c8baec047ff87dc17ba/rtl/unix/bunxovlh.inc
rtl/unix/bunxovlh.inc

Function FpWrite (fd : cInt; const buf; nbytes : TSize): TSsize; inline;
...

Thaddy de Koning

2020-07-31 21:18

reporter   ~0124443

Blockwrite can write at negative offset?

Issue History

Date Modified Username Field Change
2020-07-31 12:48 Chris Rorden New Issue
2020-07-31 13:35 Chris Rorden Note Added: 0124430
2020-07-31 18:03 Marģers Note Added: 0124438
2020-07-31 18:54 Chris Rorden Note Added: 0124440
2020-07-31 18:55 Chris Rorden Note Edited: 0124440 View Revisions
2020-07-31 21:18 Thaddy de Koning Note Added: 0124443