From 6402090f2c02f04019dc617afdaf334bffc47316 Mon Sep 17 00:00:00 2001 From: Claude Date: Sun, 21 Jun 2026 14:32:11 +0000 Subject: [PATCH 1/2] Perf: byte-at-a-time bitmap scan in NewDiscAddrToOffset Replace the bit-by-bit terminator scan with a three-phase byte-aligned scan. For large disc images with LFAU=8192, a single fragment entry can span thousands of zero bits; skipping whole zero bytes gives up to 8x fewer ReadByte calls in the inner loop. Co-Authored-By: Claude Opus 4.8 Claude-Session: https://claude.ai/code/session_012c5TpXWmyNtRKUpEUR6pUK --- LazarusSource/DiscImage_ADFS.pas | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/LazarusSource/DiscImage_ADFS.pas b/LazarusSource/DiscImage_ADFS.pas index b2d9a1e..9a9d2c6 100644 --- a/LazarusSource/DiscImage_ADFS.pas +++ b/LazarusSource/DiscImage_ADFS.pas @@ -820,11 +820,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(j0) + and not IsBitSet(ReadByte(start+(j shr 3)),j and 7)do inc(j); + while(j Date: Sun, 21 Jun 2026 14:34:02 +0000 Subject: [PATCH 2/2] Perf: pre-build ADFS new-map bitmap index for O(1) fragment lookups Before this change, every call to NewDiscAddrToOffset scanned all nzones zones of the allocation bitmap to find entries matching the target fragment ID. On a 4 GiB disc with 126 zones, loading thousands of files caused O(zones * files) total bitmap scans. BuildADFSBitmapIndex scans every zone once at disc-load time and stores the results in FBitmapIndex[fragid]. NewDiscAddrToOffset then serves reads via a direct array lookup (O(1) per call) instead of a full scan. The slow path (offset=False write paths) is unchanged. This eliminates the dominant term in load time for large ADFS HDD images. Co-Authored-By: Claude Opus 4.8 Claude-Session: https://claude.ai/code/session_012c5TpXWmyNtRKUpEUR6pUK --- LazarusSource/DiscImage.pas | 3 ++ LazarusSource/DiscImage_ADFS.pas | 69 ++++++++++++++++++++++++++++- LazarusSource/DiscImage_Private.pas | 2 + 3 files changed, 73 insertions(+), 1 deletion(-) diff --git a/LazarusSource/DiscImage.pas b/LazarusSource/DiscImage.pas index fa20378..361ffad 100755 --- a/LazarusSource/DiscImage.pas +++ b/LazarusSource/DiscImage.pas @@ -462,6 +462,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 @@ -549,6 +551,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; diff --git a/LazarusSource/DiscImage_ADFS.pas b/LazarusSource/DiscImage_ADFS.pas index 9a9d2c6..0209b43 100644 --- a/LazarusSource/DiscImage_ADFS.pas +++ b/LazarusSource/DiscImage_ADFS.pas @@ -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 : Cardinal; + 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(j0) + and not IsBitSet(ReadByte(start+(j shr 3)),j and 7)do inc(j); + while(j0 then + begin + off:=((off-(zone_spare*zone))*bpmb) mod 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 -------------------------------------------------------------------------------} @@ -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 @@ -1052,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 diff --git a/LazarusSource/DiscImage_Private.pas b/LazarusSource/DiscImage_Private.pas index 79aa295..1a014b8 100644 --- a/LazarusSource/DiscImage_Private.pas +++ b/LazarusSource/DiscImage_Private.pas @@ -65,6 +65,8 @@ procedure TDiscImage.ResetVariables; Fupdating :=False; Fcopyright :=''; Fversion :=''; + SetLength(FBitmapIndex,0); + FBitmapIndexValid:=False; end; {-------------------------------------------------------------------------------