Remove HeapInc.FirstFlag.

rtl/inc/heap.inc

@@ -279,14 +279,13 @@ type
   const
     SizeIndexBits = 1 + trunc(ln(FixedSizesCount - 1) /  ln(2));
     SizeIndexMask = 1 shl SizeIndexBits - 1;
-    FixedBitPos = {$if SizeIndexBits >= 4} SizeIndexBits {$else} 4 {$endif}; { Variable chunks use 4 low bits for used / first / last / fixed arena. }
+    FixedBitPos = {$if SizeIndexBits >= 3} SizeIndexBits {$else} 3 {$endif}; { Variable chunks use 3 low bits for used / last / fixed arena. }
     FixedFlag = 1 shl FixedBitPos;
     FixedArenaOffsetShift = {$if FixedBitPos + 1 >= 5} FixedBitPos + 1 {$else} 5 {$endif}; { VarSizeQuant must be at least 2^5 to fit 3 64-bit pointers (RbTree.Node). }
 
     UsedFlag = 1 shl 0;
-    FirstFlag = 1 shl 1;
-    LastFlag = 1 shl 2;
-    FixedArenaFlag = 1 shl 3;
+    LastFlag = 1 shl 1;
+    FixedArenaFlag = 1 shl 2;
     VarSizeQuant = 1 shl FixedArenaOffsetShift; {$if VarSizeQuant < Alignment} {$error Assumed to be >= Alignment.} {$endif} {$if VarSizeQuant < 3 * sizeof(pointer)} {$error Must fit RbTree.Node.} {$endif}
     VarSizeMask = SizeUint(-VarSizeQuant);
     HugeHeader = 0; { Special header value for huge chunks. FixedFlag must be 0, and the value must be impossible for a variable chunk. 0 turns out to be suitable. :) }
@@ -301,9 +300,9 @@ type
 
       Variable chunk header, assuming SizeIndexBits = 4:
       h[0] = used flag (h and UsedFlag <> 0)
-      h[1] = first flag (h and FirstFlag <> 0)
-      h[2] = last flag (h and LastFlag <> 0)
-      h[3] = fixed arena flag (h and FixedArenaFlag <> 0)
+      h[1] = last flag (h and LastFlag <> 0)
+      h[2] = fixed arena flag (h and FixedArenaFlag <> 0)
+      h[3] = unused
       h[4] = 0 (h and FixedFlag = 0)
       h[5:31] = size, rounded up to 32 (VarSizeQuant), shr 5; in other words, size = h and VarSizeMask.
 
@@ -370,7 +369,6 @@ type
 
       firstFreeChunk: pFreeChunk;
       usedSize, formattedSize, fullThreshold: uint32;
-      sizeIndex: uint32; { For what size it was used the last time. Allows for a small optimization when reusing fixed arenas. }
       prev, next: pFixedArena;
     end;
 
@@ -430,7 +428,7 @@ type
       function FreeFixed(p: pointer): SizeUint;
 
       function GetOSChunk(minSize, maxSize: SizeUint): pOSChunk;
-      function AllocateOSChunk(minSize: SizeUint): pOSChunk;
+      function AllocateOSChunk(minSize, maxSize: SizeUint): pOSChunk;
 
       function AllocVar(size: SizeUint; isArena: boolean): pointer;
       function FreeVar(p: pointer): SizeUint;
@@ -949,8 +947,6 @@ type
           write(f, ', used')
         else
           write(f, ', f r e e');
-        if pVarHeader(p - VarHeaderSize)^.ch.h and FirstFlag <> 0 then
-          write(f, ', first');
         if pVarHeader(p - VarHeaderSize)^.ch.h and LastFlag <> 0 then
           write(f, ', last');
         if pVarHeader(p - VarHeaderSize)^.ch.h and FixedArenaFlag <> 0 then
@@ -1010,7 +1006,7 @@ type
       result := MinFixedArenaSize;
     if result > MaxFixedArenaSize then
       result := MaxFixedArenaSize;
-    dec(result, VarHeaderSize + FixedArenaDataOffset); { Prettier fit into OS chunks. }
+    dec(result, VarHeaderSize + VarSizeQuant); { Prettier fit into OS chunks. }
   end;
 
   function HeapInc.ThreadState.AllocFixed(size: SizeUint): pointer;
@@ -1042,13 +1038,13 @@ type
           arena := AllocVar(ChooseFixedArenaSize(sizeIndex), true);
           if not Assigned(arena) then
             exit(nil);
-          arena^.sizeIndex := uint32(-1);
+          { Size index of the first chunk in the arena is used to determine if it can be reused. Set a purposely mismatching value for freshly allocated arena. }
+          pCommonHeader(pointer(arena) + FixedArenaDataOffset)^.h := uint32(not sizeIndex);
         end;
-        if arena^.sizeIndex = sizeIndex then
+        if pCommonHeader(pointer(arena) + FixedArenaDataOffset)^.h and SizeIndexMask = sizeIndex then
           { Lucky! Just don’t reset the chunk and use its old freelist. }
         else
         begin
-          arena^.sizeIndex := sizeIndex;
           arena^.firstFreeChunk := nil;
           arena^.usedSize := 0;
           arena^.formattedSize := 0;
@@ -1086,7 +1082,7 @@ type
     inc(arena^.usedSize, size);
     if arena^.usedSize >= arena^.fullThreshold then
     begin
-      inc(allocatedByFullArenas[sizeIndex], pVarHeader(arena)[-1].ch.h and VarSizeMask);
+      inc(allocatedByFullArenas[sizeIndex], pVarHeader(arena)[-1].ch.h); { Without masking with VarSizeMask, ch.h has parasite bits, but they don’t matter as long as they are unchanged, so the same value will be subtracted. }
       { Remove arena from partialArenas[sizeIndex]. (It was first.) }
       nextArena := arena^.next;
       partialArenas[sizeIndex] := nextArena;
@@ -1129,7 +1125,7 @@ type
     usedSize := arena^.usedSize;
     if usedSize >= arena^.fullThreshold then
     begin
-      dec(allocatedByFullArenas[sizeIndex], pVarHeader(arena)[-1].ch.h and VarSizeMask);
+      dec(allocatedByFullArenas[sizeIndex], pVarHeader(arena)[-1].ch.h);
       { Add arena to partialArenas[sizeIndex]. }
       nextArena := partialArenas[sizeIndex];
       arena^.next := nextArena;
@@ -1188,17 +1184,17 @@ type
       end;
     end;
   {$endif FPC_HAS_FEATURE_THREADING and not HAS_SYSOSFREE}
-    result := AllocateOSChunk(minSize);
+    result := AllocateOSChunk(minSize, maxSize);
   end;
 
-  function HeapInc.ThreadState.AllocateOSChunk(minSize: SizeUint): pOSChunk;
+  function HeapInc.ThreadState.AllocateOSChunk(minSize, maxSize: SizeUint): pOSChunk;
   var
     query, statv: SizeUint;
   begin
     query := used div 16 + minSize div 2; { Base: 6.25% of the memory used, so if GrowHeapSize2 = 1 Mb, 1 Mb OS allocations start at 16 Mb used. }
-    if query > GrowHeapSize2 then { Limit by GrowHeapSize2. }
-      query := GrowHeapSize2;
-    if query < minSize then { But of course allocate at least the amount requested. }
+    if query > maxSize then { Limit by maxSize (usually GrowHeapSize2). }
+      query := maxSize;
+    if query < minSize then { But of course allocate at least the amount requested. Also triggers if maxSize was wrong (smaller than minSize). }
       query := minSize;
     query := (query + (OSChunkVarSizeQuant - 1)) and SizeUint(-OSChunkVarSizeQuant); { Quantize. }
     result := SysOSAlloc(query);
@@ -1221,7 +1217,7 @@ type
   var
     fv, toRemove: pFreeVarChunk;
     osChunk, osNext: pVarOSChunk;
-    vSize, minSize, maxSize, statv: SizeUint;
+    vSize, statv: SizeUint;
     adj: RbTree.pNode;
   begin
     size := (size + (VarHeaderSize + VarSizeQuant - 1)) and SizeUint(-VarSizeQuant);
@@ -1240,11 +1236,7 @@ type
     end else
     begin
       toRemove := nil;
-      minSize := VarOSChunkDataOffset + size;
-      maxSize := GrowHeapSize2;
-      if maxSize < minSize then
-        maxSize := High(SizeUint); { Shouldn’t happen (unless GrowHeapSize2 is too small), so don’t optimize the case when it happens. }
-      osChunk := pVarOSChunk(GetOSChunk(minSize, maxSize));
+      osChunk := pVarOSChunk(GetOSChunk(VarOSChunkDataOffset + size, GrowHeapSize2));
       if not Assigned(osChunk) then
         exit(nil);
 
@@ -1263,7 +1255,7 @@ type
       pVarHeader(pointer(fv) - VarHeaderSize)^.threadState := @self;
     {$endif}
       vSize := SizeUint(osChunk^.size - VarOSChunkDataOffset) and SizeUint(-VarSizeQuant);
-      pVarHeader(pointer(fv) - VarHeaderSize)^.ch.h := uint32(vSize) + (FirstFlag or LastFlag);
+      pVarHeader(pointer(fv) - VarHeaderSize)^.ch.h := uint32(vSize) + LastFlag;
       fv^.size := vSize;
     end;
 
@@ -1300,15 +1292,14 @@ type
       if not Assigned(toRemove) then
         varFree.Add(@fv^.rbn);
 
-      { Allocated chunk is still first in the OS chunk if the original chunk was first. }
-      pVarHeader(result - VarHeaderSize)^.ch.h := pVarHeader(result - VarHeaderSize)^.ch.h and FirstFlag + UsedFlag + uint32(size);
+      pVarHeader(result - VarHeaderSize)^.ch.h := uint32(size) + UsedFlag;
     end else
     begin
       { Use the entire chunk. }
       if Assigned(toRemove) then
         varFree.Remove(@toRemove^.rbn);
       size := fv^.size;
-      pVarHeader(result - VarHeaderSize)^.ch.h := pVarHeader(result - VarHeaderSize)^.ch.h and (FirstFlag or LastFlag) + UsedFlag + uint32(size);
+      pVarHeader(result - VarHeaderSize)^.ch.h := pVarHeader(result - VarHeaderSize)^.ch.h and LastFlag + UsedFlag + uint32(size);
     end;
     if isArena then
       inc(pVarHeader(result)[-1].ch.h, FixedArenaFlag) { Arenas aren’t counted in “used” directly. }
@@ -1369,14 +1360,14 @@ type
       end;
     end;
 
-    if fSizeFlags and FirstFlag = 0 then
+    if pVarHeader(p - VarHeaderSize)^.prevSize <> 0 then
     begin
       p2 := p - pVarHeader(p - VarHeaderSize)^.prevSize;
       if pVarHeader(p2 - VarHeaderSize)^.ch.h and UsedFlag = 0 then
       begin
         p := p2;
-        fSizeFlags := (fSizeFlags + pFreeVarChunk(p2)^.size) + pVarHeader(p2 - VarHeaderSize)^.ch.h and FirstFlag;
-        { Keep the largest chunk in toRemove as it will have more chances for ChangeInPlace succeeding. }
+        fSizeFlags := fSizeFlags + pFreeVarChunk(p2)^.size;
+        { Keep the largest chunk in toRemove as only the largest of the two has any chances for ChangeInPlace succeeding (final free chunk is sum of these + p). }
         if Assigned(toRemove) then
           if pFreeVarChunk(p2)^.size >= toRemove^.size then
           begin
@@ -1391,7 +1382,7 @@ type
 
     { Turn p into a free chunk and add it back to varFree...
       unless it spans the entire OS chunk, in which case instead move the chunk from varOS to freeOS. }
-    if fSizeFlags and (FirstFlag or LastFlag) <> FirstFlag or LastFlag then
+    if (pVarHeader(p - VarHeaderSize)^.prevSize <> 0) or (fSizeFlags and LastFlag = 0) then
     begin
       if Assigned(toRemove) then
       begin
@@ -1514,7 +1505,7 @@ type
       end;
 
       { Update p size. }
-      pVarHeader(result - VarHeaderSize)^.ch.h := uint32(size) + pVarHeader(result - VarHeaderSize)^.ch.h and (FirstFlag or UsedFlag);
+      pVarHeader(result - VarHeaderSize)^.ch.h := uint32(size) + UsedFlag;
     end
     { Grow if there is free space. }
     else if (pVarHeader(result - VarHeaderSize)^.ch.h and LastFlag = 0) and (pVarHeader(p2 - VarHeaderSize)^.ch.h and UsedFlag = 0) and
@@ -1541,7 +1532,7 @@ type
 
       toRemove := p2;
       { Update p size. }
-      pVarHeader(result - VarHeaderSize)^.ch.h := uint32(size) + pVarHeader(result - VarHeaderSize)^.ch.h and (FirstFlag or UsedFlag);
+      pVarHeader(result - VarHeaderSize)^.ch.h := uint32(size) + UsedFlag;
       { No empty chunk? }
       if fSizeFlags = 0 then
       begin
@@ -1804,7 +1795,7 @@ type
         nextArena^.prev := arena;
       partialArenas[sizeIndex] := arena;
     end else
-      inc(allocatedByFullArenas[sizeIndex], pVarHeader(arena)[-1].ch.h and VarSizeMask);
+      inc(allocatedByFullArenas[sizeIndex], pVarHeader(arena)[-1].ch.h);
   end;
 
   procedure HeapInc.ThreadState.AdoptVarOwner(p: pointer);