Skip to content

Stream larger-than-RAM (>4GB) images instead of loading them into memory #48

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Closed
philpem wants to merge 9 commits into from
Closed

Stream larger-than-RAM (>4GB) images instead of loading them into memory #48

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
9 commits
Select commit Hold shift + click to select a range
67e4fc3
Fix EStringListError crash in TRegistrySettings on second run
claude Jun 21, 2026
e2bb9c4
Merge pull request #5 from philpem/fix/registry-settings-sorted-list-…
philpem Jun 21, 2026
6402090
Perf: byte-at-a-time bitmap scan in NewDiscAddrToOffset
claude Jun 21, 2026
b692e8f
Perf: pre-build ADFS new-map bitmap index for O(1) fragment lookups
claude Jun 21, 2026
47a53e1
Merge pull request #6 from philpem/perf/adfs-bitmap-index
philpem Jun 21, 2026
f9edf91
Widen image addressing from 32-bit Cardinal to 64-bit Int64
claude Jun 21, 2026
a582733
Report a clear message when an image is too large for memory
claude Jun 21, 2026
15a39d3
Stream large images from disc instead of loading them into RAM
claude Jun 21, 2026
f6aa4bb
Stream large gzip-compressed images via a temporary file
claude Jun 21, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
78 changes: 56 additions & 22 deletions LazarusSource/DiscImage.pas
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -166,6 +166,10 @@ TFileEntry = record
diFSMDir = $FD;
diFSMSystem = $FE;
diFSMUsed = $FF;
//Streamed (read-only) backend - windowed page cache
diStreamPageSize = 65536; //64 KB per cache page
diStreamPageCount = 64; //Number of cache pages (~4 MB resident)
diStreamThreshold = $80000000; //2 GiB - default streamed-load size threshold

//TSpark class definition
type
Expand Down Expand Up @@ -368,18 +372,32 @@ TPartition = record //Details about the partition
TPartitions = array of TPartition;
//Fragment
TFragment = record //For retrieving the ADFS E/F fragment information
Offset,
Offset : Int64; //Byte offset into the image (can exceed 4GB)
Length,
Zone : Cardinal;
end;
//To collate fragments (ADFS/CDR/Amiga/AFS)
TFragmentArray= array of TFragment;
//A single resident page of the streamed (read-only) backend cache
TDIPage = record
Tag : Int64; //Page-aligned file offset, -1 when the slot is empty
LastUse : QWord; //FPageClock value when last accessed (for LRU eviction)
Data : TDIByteArray; //diStreamPageSize bytes of image data
end;
//Provides feedback
TProgressProc = procedure(Fupdate: String) of Object;
private
FDisc : TDisc; //Container for the entire catalogue
FPartitions : TPartitions; //Container for the entire catalogue (partitioned)
Fdata : TDIByteArray; //Container for the image to be loaded into
//Streamed (read-only) backend - used when the image is too large for RAM
FStreamed : Boolean; //True when the image is served from the file on demand
FBackStream : TFileStream; //Backing file, kept open for the image lifetime
FBackSize : Int64; //Authoritative image length when streamed
FBackTemp : String; //Temp file to delete on close ('' if none)
FPageCache : array of TDIPage; //Windowed read-through cache (streamed mode)
FPageClock : QWord; //Monotonic counter driving LRU eviction
FStreamThreshold: Int64; //Size at/above which images are streamed (0=never)
FDSD, //Double sided flag (Acorn DFS)
FMap, //Old/New Map flag (Acorn ADFS) OFS/FFS (Amiga)
FBootBlock, //Is disc an AmigaDOS Kickstart?
Expand Down Expand Up @@ -450,6 +468,7 @@ TFragment = record //For retrieving the ADFS E/F fragment informati
root_name, //Root title
dosrootname, //DOS Plus root name
imagefilename, //Filename of the disc image
FLoadError, //Reason the last load failed (e.g. too large)
FFilename : String; //Copy of above, but doesn't get wiped
dir_sep : Char; //Directory Separator
free_space_map: TSide; //Free Space Map
Expand All @@ -462,6 +481,8 @@ TFragment = record //For retrieving the ADFS E/F fragment informati
SparkFile : TSpark; //For reading in Spark archives
FDSKImage : TDSKImage; //For reading in Sinclair/Amstrad DSK files
ISOVolDes : array of TISOVolDes;//ISO Volume Descriptors
FBitmapIndex : array of TFragmentArray;//Pre-built ADFS new-map lookup index
FBitmapIndexValid : Boolean; //True once FBitmapIndex is populated
//Disc title for new images
Fdisctitle,
Fafsdisctitle, //AFS has longer titles
Expand Down Expand Up @@ -489,33 +510,41 @@ TFragment = record //For retrieving the ADFS E/F fragment informati
buffer: TDIByteArray); overload;
function RISCOSToTimeDate(filedatetime: Int64): TDateTime;
function TimeDateToRISCOS(delphitime: TDateTime): Int64;
function Read32b(offset: Cardinal; bigendian: Boolean=False): Cardinal;
function Read32b(offset: Cardinal; var buffer: TDIByteArray;
function Read32b(offset: Int64; bigendian: Boolean=False): Cardinal;
function Read32b(offset: Int64; var buffer: TDIByteArray;
bigendian: Boolean=False): Cardinal; overload;
function Read24b(offset: Cardinal; bigendian: Boolean=False): Cardinal;
function Read24b(offset: Cardinal; var buffer: TDIByteArray;
function Read24b(offset: Int64; bigendian: Boolean=False): Cardinal;
function Read24b(offset: Int64; var buffer: TDIByteArray;
bigendian: Boolean=False): Cardinal; overload;
function Read16b(offset: Cardinal; bigendian: Boolean=False): Word;
function Read16b(offset: Cardinal; var buffer: TDIByteArray;
function Read16b(offset: Int64; bigendian: Boolean=False): Word;
function Read16b(offset: Int64; var buffer: TDIByteArray;
bigendian: Boolean=False): Word; overload;
function ReadByte(offset: Cardinal): Byte;
function ReadByte(offset: Cardinal; var buffer: TDIByteArray): Byte; overload;
function ReadByte(offset: Int64): Byte;
function ReadByte(offset: Int64; var buffer: TDIByteArray): Byte; overload;
function ReadByteBackend(offset: Int64): Byte;
function ShouldStream(filesize: Int64): Boolean;
function OpenStreamed(filename: String): Boolean;
procedure CloseStream;
function FileStartsGZip(filename: String): Boolean;
function SizeOfFile(filename: String): Int64;
function CountGZipMembers(filename: String): Integer;
function InflateGZipToFile(srcfile,destfile: String): Boolean;
procedure RemoveDirectory(dirref: Cardinal);
function DiscAddrToIntOffset(disc_addr: Cardinal): Cardinal;
procedure Write32b(value, offset: Cardinal; bigendian: Boolean=False);
procedure Write32b(value, offset: Cardinal; var buffer: TDIByteArray;
function DiscAddrToIntOffset(disc_addr: Int64): Int64;
procedure Write32b(value: Cardinal; offset: Int64; bigendian: Boolean=False);
procedure Write32b(value: Cardinal; offset: Int64; var buffer: TDIByteArray;
bigendian: Boolean=False); overload;
procedure Write24b(value, offset: Cardinal; bigendian: Boolean=False);
procedure Write24b(value, offset: Cardinal; var buffer: TDIByteArray;
procedure Write24b(value: Cardinal; offset: Int64; bigendian: Boolean=False);
procedure Write24b(value: Cardinal; offset: Int64; var buffer: TDIByteArray;
bigendian: Boolean=False); overload;
procedure Write16b(value: Word; offset: Cardinal; bigendian: Boolean=False);
procedure Write16b(value: Word; offset: Cardinal; var buffer: TDIByteArray;
procedure Write16b(value: Word; offset: Int64; bigendian: Boolean=False);
procedure Write16b(value: Word; offset: Int64; var buffer: TDIByteArray;
bigendian: Boolean=False); overload;
procedure WriteByte(value: Byte; offset: Cardinal);
procedure WriteByte(value: Byte; offset: Cardinal;
procedure WriteByte(value: Byte; offset: Int64);
procedure WriteByte(value: Byte; offset: Int64;
var buffer: TDIByteArray); overload;
function GetDataLength: Cardinal;
procedure SetDataLength(newlen: Cardinal);
function GetDataLength: Int64;
procedure SetDataLength(newlen: Int64);
function ROR13(v: Cardinal): Cardinal;
procedure ResetDir(var Entry: TDir);
function MapFlagToByte: Byte;
Expand Down Expand Up @@ -549,6 +578,7 @@ TFragment = record //For retrieving the ADFS E/F fragment informati
buffer: TDIByteArray): Byte; overload;
function NewDiscAddrToOffset(addr: Cardinal;
offset: Boolean=True): TFragmentArray;
procedure BuildADFSBitmapIndex;
function OffsetToOldDiscAddr(offset: Cardinal): Cardinal;
function ByteChecksum(offset,size: Cardinal;newmap: Boolean): Byte;
function ByteChecksum(offset,size: Cardinal;newmap: Boolean;
Expand Down Expand Up @@ -992,7 +1022,7 @@ TFragment = record //For retrieving the ADFS E/F fragment informati
function MoveFile(filename,directory: String): Integer;
function MoveFile(source: Cardinal;dest: Integer): Integer; overload;
function ReadDirectory(dirname: String): Integer;
function ReadDiscData(addr,count,side,offset: Cardinal;
function ReadDiscData(addr,count: Int64; side: Cardinal; offset: Int64;
var buffer: TDIByteArray): Boolean;
procedure ReadImage;
function ReadPasswordFile: TUserAccounts;
Expand All @@ -1016,7 +1046,7 @@ TFragment = record //For retrieving the ADFS E/F fragment informati
function UpdateVersionString(version: String): Boolean;
procedure ValidateAttributes(var attributes: String);
function ValidateFilename(parent:String;var filename:String): Boolean;
function WriteDiscData(addr,side: Cardinal;var buffer: TDIByteArray;
function WriteDiscData(addr: Int64; side: Cardinal;var buffer: TDIByteArray;
count: Cardinal;start: Cardinal=0): Boolean;
function WriteFile(var file_details: TDirEntry;
var buffer: TDIByteArray;ShowFSM: Boolean=False): Integer;
Expand Down Expand Up @@ -1072,6 +1102,7 @@ TFragment = record //For retrieving the ADFS E/F fragment informati
property MajorFormatNumber: Word read GetMajorFormatNumber;
property MapType: Byte read MapFlagToByte;
property MapTypeString: String read MapTypeToString;
property LoadErrorMessage: String read FLoadError;
property MaxDirectoryEntries: Cardinal read FMaxDirEnt;
property MinorFormatNumber: Byte read GetMinorFormatNumber;
property OpenDOSPartitions: Boolean read FOpenDOSPart
Expand All @@ -1083,6 +1114,9 @@ TFragment = record //For retrieving the ADFS E/F fragment informati
property RootName: String read root_name;
property ScanSubDirs: Boolean read FScanSubDirs
write FScanSubDirs;
property Streamed: Boolean read FStreamed;
property StreamThreshold: Int64 read FStreamThreshold
write FStreamThreshold;
property Sectors: Byte read secspertrack;
property SparkAsFS: Boolean read FSparkAsFS
write FSparkAsFS;
Expand Down
23 changes: 17 additions & 6 deletions LazarusSource/DiscImageContext.pas
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -275,11 +275,14 @@ function TRegistrySettings.GetBool(const Key: String; Default: Boolean): Boolean
end;

procedure TRegistrySettings.SetBool(const Key: String; Value: Boolean);
var
i: Integer;
s: String;
begin
if Value then
FSettings.Values[Key] := 'true'
else
FSettings.Values[Key] := 'false';
if Value then s := 'true' else s := 'false';
i := FSettings.IndexOfName(Key);
if i >= 0 then FSettings.Delete(i);
FSettings.Add(Key + '=' + s);
FModified := True;
end;

Expand All @@ -295,8 +298,12 @@ function TRegistrySettings.GetInt(const Key: String; Default: Integer): Integer;
end;

procedure TRegistrySettings.SetInt(const Key: String; Value: Integer);
var
i: Integer;
begin
FSettings.Values[Key] := IntToStr(Value);
i := FSettings.IndexOfName(Key);
if i >= 0 then FSettings.Delete(i);
FSettings.Add(Key + '=' + IntToStr(Value));
FModified := True;
end;

Expand All @@ -308,8 +315,12 @@ function TRegistrySettings.GetString(const Key: String; const Default: String):
end;

procedure TRegistrySettings.SetString(const Key: String; const Value: String);
var
i: Integer;
begin
FSettings.Values[Key] := Value;
i := FSettings.IndexOfName(Key);
if i >= 0 then FSettings.Delete(i);
FSettings.Add(Key + '=' + Value);
FModified := True;
end;

Expand Down
90 changes: 81 additions & 9 deletions LazarusSource/DiscImage_ADFS.pas
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -747,6 +747,62 @@ function TDiscImage.CalculateADFSDirCheck(sector:Cardinal;buffer:TDIByteArray):
XOR ((dircheck>> 8)AND$FF);
end;

{-------------------------------------------------------------------------------
Build a lookup index of all ADFS new-map fragment entries.
Called once per disc load; thereafter NewDiscAddrToOffset uses O(1) lookup
instead of scanning all nzones zones for every file.
-------------------------------------------------------------------------------}
procedure TDiscImage.BuildADFSBitmapIndex;
const
dr_size = $40;
header = 4;
var
zone : Cardinal;
i,j : Cardinal;
allmap: Cardinal;
start : Cardinal;
id : Cardinal;
off : Int64; //Byte offset into the image (can exceed 4GB on large discs)
len : Cardinal;
n : Integer;
begin
FBitmapIndexValid:=False;
SetLength(FBitmapIndex,0);
if not FMap then exit;
if(idlen=0)or(bpmb=0)or(disc_size[0]=0)then exit;
SetLength(FBitmapIndex,1 shl idlen);
for zone:=0 to nzones-1 do
begin
start :=bootmap+dr_size;
allmap:=(zone+1)*secsize*8-dr_size*8;
i :=zone*secsize*8;
if zone>0 then dec(i,dr_size*8-header*8);
repeat
off:=i;
id :=ReadBits(start,i,idlen);
inc(i,idlen);
j:=i;
while(j<allmap)and((j and 7)<>0)
and not IsBitSet(ReadByte(start+(j shr 3)),j and 7)do inc(j);
while(j<allmap)and((j and 7)=0)and(ReadByte(start+(j shr 3))=0)do inc(j,8);
while(j<allmap)and not IsBitSet(ReadByte(start+(j shr 3)),j and 7)do inc(j);
len:=((j-i)+1+idlen)*bpmb;
i:=j;
if id>0 then
begin
off:=((off-(zone_spare*zone))*Int64(bpmb)) mod Int64(disc_size[0]);
n:=Length(FBitmapIndex[id]);
SetLength(FBitmapIndex[id],n+1);
FBitmapIndex[id][n].Offset:=off;
FBitmapIndex[id][n].Length:=len;
FBitmapIndex[id][n].Zone :=zone;
end;
inc(i);
until i>=allmap;
end;
FBitmapIndexValid:=True;
end;

{-------------------------------------------------------------------------------
Convert an ADFS New Map address to buffer offset address, with fragment lengths
-------------------------------------------------------------------------------}
Expand All @@ -759,7 +815,7 @@ function TDiscImage.NewDiscAddrToOffset(addr: Cardinal;
id : Cardinal=0;
allmap : Cardinal=0;
len : Cardinal=0;
off : Cardinal=0;
off : Int64=0; //Byte offset into the image (can exceed 4GB)
zone : Cardinal=0;
start : Cardinal=0;
start_zone : Cardinal=0;
Expand Down Expand Up @@ -795,7 +851,16 @@ function TDiscImage.NewDiscAddrToOffset(addr: Cardinal;
sector:=addr mod $100;
//Sector needs to have 1 subtracted, if >=1
if sector>=1 then dec(sector);
//Go through the allocation map, looking for the fragment
//Fast path: use pre-built index when available (offset=True only)
if FBitmapIndexValid and offset then
begin
Result:=Copy(FBitmapIndex[fragid]);
if Length(Result)>0 then
for i:=0 to Length(Result)-1 do
inc(Result[i].Offset,sector*secsize);
exit;
end;
//Slow path: scan the allocation map zone by zone
//First we need to know how many ids per zone there are (max)
id_per_zone:=((secsize*8)-zone_spare)div(idlen+1);
//Then work out the start zone
Expand All @@ -820,11 +885,16 @@ function TDiscImage.NewDiscAddrToOffset(addr: Cardinal;
id:=ReadBits(start,i,idlen);
//and move the pointer on idlen bits
inc(i,idlen);
//Now find the end of the fragment entry
j:=i-1;
repeat
inc(j);
until(IsBitSet(ReadByte(start+(j div 8)),j mod 8))or(j>=allmap);
//Now find the end of the fragment entry.
//Byte-at-a-time scan (up to 8x faster than bit-by-bit for large allocations):
// Phase 1: bit-by-bit until byte-aligned (at most 7 bits)
// Phase 2: skip zero bytes 8 bits at a time
// Phase 3: bit-by-bit within the last non-zero byte (at most 8 bits)
j:=i;
while(j<allmap)and((j and 7)<>0)
and not IsBitSet(ReadByte(start+(j shr 3)),j and 7)do inc(j);
while(j<allmap)and((j and 7)=0)and(ReadByte(start+(j shr 3))=0)do inc(j,8);
while(j<allmap)and not IsBitSet(ReadByte(start+(j shr 3)),j and 7)do inc(j);
//Make a note of the length
if offset then
len:=((j-i)+1+idlen)*bpmb
Expand All @@ -836,7 +906,7 @@ function TDiscImage.NewDiscAddrToOffset(addr: Cardinal;
if id=fragid then
begin
if offset then //Offset as image file offset
off:=((off-(zone_spare*zone))*bpmb) mod disc_size[0]
off:=((off-(zone_spare*zone))*Int64(bpmb)) mod Int64(disc_size[0])
else //Offset as number of bits from start of zone
begin
//Add the disc record (we are counting from the zone start
Expand Down Expand Up @@ -1047,6 +1117,8 @@ TVisit = record
format_vers :=Read32b(bootmap+$30);
root_size :=Read32b(bootmap+$34);
if root_size=0 then root_size:=$800;
//Build the bitmap index for O(1) fragment lookups during directory traversal
BuildADFSBitmapIndex;
//The root does not always follow the map
addr:=NewDiscAddrToOffset(rootfrag);
//So, find it - first reset it
Expand Down Expand Up @@ -3748,7 +3820,7 @@ function TDiscImage.ExtractFragmentedData(fragments: TFragmentArray;
var
dest : Cardinal=0;
len : Cardinal=0;
source : Cardinal=0;
source : Int64=0; //Byte offset into the image (can exceed 4GB)
frag : Cardinal=0; //Pointer into the fragment array
begin
Result:=False;
Expand Down
Loading