diff options
Diffstat (limited to 'rtl/inc/tinyheap.inc')
| -rw-r--r-- | rtl/inc/tinyheap.inc | 544 |
1 files changed, 424 insertions, 120 deletions
diff --git a/rtl/inc/tinyheap.inc b/rtl/inc/tinyheap.inc index 38fa5421b2..155417b67c 100644 --- a/rtl/inc/tinyheap.inc +++ b/rtl/inc/tinyheap.inc @@ -13,74 +13,149 @@ **********************************************************************} - const - TinyHeapMinBlock = 4*sizeof(pointer); +{ The heap, implemented here is TP7-compatible in the i8086 far data memory + models. It's basically a linked list of free blocks, which are kept ordered by + start address. The FreeList variable points to the start of the list. Each + free block, except the last one, contains a TTinyHeapBlock structure, which + holds the block size and a pointer to the next free block. The HeapPtr + variable points to the last free block, indicating the end of the list. The + last block is special in that it doesn't contain a TTinyHeapBlock structure. + Instead its size is determined by the pointer difference (HeapEnd-HeapPtr). + It *can* become zero sized, when all the memory inside of it is allocated, in + which case, HeapPtr will become equal to HeapEnd. } + +{$ifdef FPC_TINYHEAP_HUGE} + {$HugePointerArithmeticNormalization On} + {$HugePointerComparisonNormalization On} +{$endif FPC_TINYHEAP_HUGE} type + { TTinyHeapMemBlockSize holds the size of an *allocated* memory block, + and is written at position: + memblockstart-sizeof(TTinyHeapMemBlockSize) } + PTinyHeapMemBlockSize = ^TTinyHeapMemBlockSize; {$ifdef FPC_TINYHEAP_HUGE}huge;{$endif} + TTinyHeapMemBlockSize = PtrUInt; + + { TTinyHeapFreeBlockSize holds the size of a *free* memory block, as a + part of the TTinyHeapBlock structure } +{$ifdef FPC_TINYHEAP_HUGE} + TTinyHeapFreeBlockSize = record + OfsSize: Word; + SegSize: Word; + end; +{$else FPC_TINYHEAP_HUGE} + TTinyHeapFreeBlockSize = PtrUInt; +{$endif FPC_TINYHEAP_HUGE} + + TTinyHeapPointerArithmeticType = ^Byte; {$ifdef FPC_TINYHEAP_HUGE}huge;{$endif} + PTinyHeapBlock = ^TTinyHeapBlock; TTinyHeapBlock = record - Size: ptruint; Next: PTinyHeapBlock; - EndAddr: pointer; + Size: TTinyHeapFreeBlockSize; end; - var - TinyHeapBlocks: PTinyHeapBlock = nil; + const + TinyHeapMinBlock = sizeof(TTinyHeapBlock); - procedure InternalTinyFreeMem(Addr: Pointer; Size: ptruint); forward; + TinyHeapAllocGranularity = sizeof(TTinyHeapBlock); - function FindSize(p: pointer): ptruint; + function EncodeTinyHeapFreeBlockSize(Size: PtrUInt): TTinyHeapFreeBlockSize; inline; begin - FindSize := PPtrUInt(p)[-1]; +{$ifdef FPC_TINYHEAP_HUGE} + EncodeTinyHeapFreeBlockSize.OfsSize := Size and 15; + EncodeTinyHeapFreeBlockSize.SegSize := Size shr 4; +{$else FPC_TINYHEAP_HUGE} + EncodeTinyHeapFreeBlockSize := Size; +{$endif FPC_TINYHEAP_HUGE} + end; + + function DecodeTinyHeapFreeBlockSize(Size: TTinyHeapFreeBlockSize): PtrUInt; inline; + begin +{$ifdef FPC_TINYHEAP_HUGE} + DecodeTinyHeapFreeBlockSize := (PtrUInt(Size.SegSize) shl 4) + Size.OfsSize; +{$else FPC_TINYHEAP_HUGE} + DecodeTinyHeapFreeBlockSize := Size; +{$endif FPC_TINYHEAP_HUGE} + end; + + procedure InternalTinyFreeMem(Addr: Pointer; Size: PtrUInt); forward; + + function FindSize(p: pointer): TTinyHeapMemBlockSize; + begin + FindSize := PTinyHeapMemBlockSize(p)[-1]; end; function SysTinyGetMem(Size: ptruint): pointer; var - p, prev: PTinyHeapBlock; + p, prev, p2: PTinyHeapBlock; AllocSize, RestSize: ptruint; begin {$ifdef DEBUG_TINY_HEAP} Write('SysTinyGetMem(', Size, ')='); {$endif DEBUG_TINY_HEAP} - AllocSize := align(size+sizeof(ptruint), sizeof(pointer)); + AllocSize := align(size+sizeof(TTinyHeapMemBlockSize), TinyHeapAllocGranularity); - p := TinyHeapBlocks; + p := FreeList; prev := nil; - while assigned(p) and (p^.Size < AllocSize) do + while (p<>HeapPtr) and (DecodeTinyHeapFreeBlockSize(p^.Size) < AllocSize) do begin prev := p; p := p^.Next; end; - if assigned(p) then + if p<>HeapPtr then begin - result := @pptruint(p)[1]; + result := @PTinyHeapMemBlockSize(p)[1]; - if p^.Size-AllocSize >= TinyHeapMinBlock then - RestSize := p^.Size-AllocSize + if DecodeTinyHeapFreeBlockSize(p^.Size)-AllocSize >= TinyHeapMinBlock then + RestSize := DecodeTinyHeapFreeBlockSize(p^.Size)-AllocSize else begin - AllocSize := p^.Size; + AllocSize := DecodeTinyHeapFreeBlockSize(p^.Size); RestSize := 0; end; - if prev = nil then - TinyHeapBlocks := p^.Next + if RestSize > 0 then + begin + p2 := pointer(TTinyHeapPointerArithmeticType(p)+AllocSize); + p2^.Next := p^.Next; + p2^.Size := EncodeTinyHeapFreeBlockSize(RestSize); + if prev = nil then + FreeList := p2 + else + prev^.next := p2; + end else - prev^.next := p^.next; - - pptruint(p)^ := size; + begin + if prev = nil then + FreeList := p^.Next + else + prev^.next := p^.next; + end; - if RestSize > 0 then - InternalTinyFreeMem(pointer(ptruint(p)+AllocSize), RestSize); + PTinyHeapMemBlockSize(p)^ := size; end else - if ReturnNilIfGrowHeapFails then - Result := nil - else - HandleError(203); + begin + { p=HeapPtr } + if PtrUInt(TTinyHeapPointerArithmeticType(HeapEnd)-TTinyHeapPointerArithmeticType(HeapPtr))<AllocSize then + if ReturnNilIfGrowHeapFails then + Result := nil + else + HandleError(203); + + result := @PTinyHeapMemBlockSize(HeapPtr)[1]; + PTinyHeapMemBlockSize(HeapPtr)^ := size; + + HeapPtr := pointer(TTinyHeapPointerArithmeticType(HeapPtr)+AllocSize); + if prev = nil then + FreeList := HeapPtr + else + prev^.next := HeapPtr; + end; {$ifdef DEBUG_TINY_HEAP} - Writeln(ptruint(Result)); + Writeln(HexStr(Result)); {$endif DEBUG_TINY_HEAP} end; @@ -95,80 +170,52 @@ begin mem := GetMem(Size+Alignment-1); memp := align(ptruint(mem), Alignment); - InternalTinyFreeMem(mem, ptruint(memp)-ptruint(mem)); + InternalTinyFreeMem(mem, TTinyHeapPointerArithmeticType(memp)-TTinyHeapPointerArithmeticType(mem)); result := pointer(memp); end; end; - procedure InternalTinyFreeMem(Addr: Pointer; Size: ptruint); - var - b, p, prev: PTinyHeapBlock; - concatenated: boolean; + procedure InternalTinyFreeMem(Addr: Pointer; Size: PtrUInt); + var + p, prev: PTinyHeapBlock; begin - repeat - concatenated := false; - b := addr; + p := FreeList; + prev := nil; - b^.Next := TinyHeapBlocks; - b^.Size := Size; - b^.EndAddr := pointer(ptruint(addr)+size); + while (p<>HeapPtr) and (TTinyHeapPointerArithmeticType(p) < TTinyHeapPointerArithmeticType(Addr)) do + begin + prev := p; + p := p^.Next; + end; - if TinyHeapBlocks = nil then - TinyHeapBlocks := b + { join with previous block? } + if assigned(prev) and ((TTinyHeapPointerArithmeticType(prev)+DecodeTinyHeapFreeBlockSize(prev^.Size)) = TTinyHeapPointerArithmeticType(Addr)) then + begin + Addr:=prev; + Size:=DecodeTinyHeapFreeBlockSize(prev^.size)+Size; + end + else + if assigned(prev) then + prev^.Next := Addr else - begin - p := TinyHeapBlocks; - prev := nil; - - while assigned(p) do - begin - if p^.EndAddr = addr then - begin - addr:=p; - size:=p^.size+size; - if prev = nil then - TinyHeapBlocks:=p^.next - else - prev^.next:=p^.next; - concatenated:=true; - break; - end - else if p = b^.EndAddr then - begin - size:=p^.size+size; - if prev = nil then - TinyHeapBlocks:=p^.next - else - prev^.next:=p^.next; - concatenated:=true; - break; - end; - - prev := p; - p := p^.next; - end; - - if not concatenated then - begin - p := TinyHeapBlocks; - prev := nil; - - while assigned(p) and (p^.Size < size) do - begin - prev := p; - p := p^.Next; - end; - - if assigned(prev) then - begin - b^.Next := p; - prev^.Next := b; - end - else - TinyHeapBlocks := b; - end; - end; - until not concatenated; + FreeList := Addr; + + { join with next block? } + if TTinyHeapPointerArithmeticType(p)=(TTinyHeapPointerArithmeticType(Addr)+Size) then + begin + if p=HeapPtr then + HeapPtr:=Addr + else + begin + PTinyHeapBlock(Addr)^.Next:=p^.Next; + PTinyHeapBlock(Addr)^.Size:=EncodeTinyHeapFreeBlockSize(Size+DecodeTinyHeapFreeBlockSize(p^.Size)); + end; + end + else + begin + PTinyHeapBlock(Addr)^.Next:=p; + PTinyHeapBlock(Addr)^.Size:=EncodeTinyHeapFreeBlockSize(Size); + end; end; function SysTinyFreeMem(Addr: Pointer): ptruint; @@ -176,16 +223,19 @@ sz: ptruint; begin {$ifdef DEBUG_TINY_HEAP} - Writeln('SysTinyFreeMem(', ptruint(Addr), ')'); + Writeln('SysTinyFreeMem(', HexStr(Addr), ')'); {$endif DEBUG_TINY_HEAP} if addr=nil then begin result:=0; exit; end; - sz := Align(FindSize(addr)+SizeOf(ptruint), sizeof(pointer)); + if (TTinyHeapPointerArithmeticType(addr) < TTinyHeapPointerArithmeticType(HeapOrg)) or + (TTinyHeapPointerArithmeticType(addr) >= TTinyHeapPointerArithmeticType(HeapPtr)) then + HandleError(204); + sz := Align(FindSize(addr)+SizeOf(TTinyHeapMemBlockSize), TinyHeapAllocGranularity); - InternalTinyFreeMem(@pptruint(addr)[-1], sz); + InternalTinyFreeMem(@PTinyHeapMemBlockSize(addr)[-1], sz); result := sz; end; @@ -209,46 +259,300 @@ function SysTinyReAllocMem(var p: pointer; size: ptruint):pointer; var - sz: ptruint; + oldsize, OldAllocSize, NewAllocSize: ptruint; + after_block, before_block, before_before_block: PTinyHeapBlock; + after_block_size, before_block_size: PtrUInt; + new_after_block: PTinyHeapBlock; begin {$ifdef DEBUG_TINY_HEAP} - Write('SysTinyReAllocMem(', ptruint(p), ',', size, ')='); + Write('SysTinyReAllocMem(', HexStr(p), ',', size, ')='); {$endif DEBUG_TINY_HEAP} if size=0 then - result := nil + begin + SysTinyFreeMem(p); + result := nil; + p := nil; + end + else if p=nil then + begin + result := AllocMem(size); + p := result; + end else - result := AllocMem(size); - if result <> nil then begin - if p <> nil then + if (TTinyHeapPointerArithmeticType(p) < TTinyHeapPointerArithmeticType(HeapOrg)) or + (TTinyHeapPointerArithmeticType(p) >= TTinyHeapPointerArithmeticType(HeapPtr)) then + HandleError(204); + oldsize := FindSize(p); + OldAllocSize := align(oldsize+sizeof(TTinyHeapMemBlockSize), TinyHeapAllocGranularity); + NewAllocSize := align(size+sizeof(TTinyHeapMemBlockSize), TinyHeapAllocGranularity); + if OldAllocSize = NewAllocSize then + begin + { old and new size are the same after alignment, so the memory block is already allocated } + { we just need to update the size } + PTinyHeapMemBlockSize(p)[-1] := size; + if size > oldsize then + FillChar((TTinyHeapPointerArithmeticType(p)+oldsize)^, size-oldsize, 0); + end + else if OldAllocSize > NewAllocSize then begin - sz := FindSize(p); - if sz > size then - sz := size; - move(pbyte(p)^, pbyte(result)^, sz); + { we're decreasing the memory block size, so we can just free the remaining memory at the end } + PTinyHeapMemBlockSize(p)[-1] := size; + InternalTinyFreeMem(Pointer(TTinyHeapPointerArithmeticType(p)+(NewAllocSize-PtrUInt(SizeOf(TTinyHeapMemBlockSize)))), OldAllocSize-NewAllocSize); + end + else + begin + { we're increasing the memory block size. First, find if there are free memory blocks immediately + before and after our memory block. } + after_block := FreeList; + before_block := nil; + before_before_block := nil; + while (after_block<>HeapPtr) and (TTinyHeapPointerArithmeticType(after_block) < TTinyHeapPointerArithmeticType(p)) do + begin + before_before_block := before_block; + before_block := after_block; + after_block := after_block^.Next; + end; + { is after_block immediately after our block? } + if after_block=Pointer(TTinyHeapPointerArithmeticType(p)+(OldAllocSize-PtrUInt(SizeOf(TTinyHeapMemBlockSize)))) then + begin + if after_block = HeapPtr then + after_block_size := PtrUInt(TTinyHeapPointerArithmeticType(HeapEnd)-TTinyHeapPointerArithmeticType(HeapPtr)) + else + after_block_size := DecodeTinyHeapFreeBlockSize(after_block^.size); + end + else + after_block_size := 0; + { is there enough room after the block? } + if (OldAllocSize+after_block_size)>=NewAllocSize then + begin + if after_block = HeapPtr then + begin + HeapPtr:=Pointer(TTinyHeapPointerArithmeticType(HeapPtr)+(NewAllocSize-OldAllocSize)); + if assigned(before_block) then + before_block^.Next := HeapPtr + else + FreeList := HeapPtr; + end + else + begin + if (NewAllocSize-OldAllocSize)=after_block_size then + begin + if assigned(before_block) then + before_block^.Next := after_block^.Next + else + FreeList := after_block^.Next; + end + else + begin + new_after_block := PTinyHeapBlock(TTinyHeapPointerArithmeticType(after_block)+(NewAllocSize-OldAllocSize)); + new_after_block^.Next:=after_block^.Next; + new_after_block^.Size:=EncodeTinyHeapFreeBlockSize(after_block_size-(NewAllocSize-OldAllocSize)); + if assigned(before_block) then + before_block^.Next := new_after_block + else + FreeList := new_after_block; + end; + end; + PTinyHeapMemBlockSize(p)[-1] := size; + FillChar((TTinyHeapPointerArithmeticType(p)+oldsize)^, size-oldsize, 0); + end + else + begin + { is before_block immediately before our block? } + if assigned(before_block) and (Pointer(TTinyHeapPointerArithmeticType(before_block)+DecodeTinyHeapFreeBlockSize(before_block^.Size))=Pointer(TTinyHeapPointerArithmeticType(p)-SizeOf(TTinyHeapMemBlockSize))) then + before_block_size := DecodeTinyHeapFreeBlockSize(before_block^.Size) + else + before_block_size := 0; + + { if there's enough space, we can slide our current block back and reclaim before_block } + if (before_block_size<NewAllocSize) and ((before_block_size+OldAllocSize+after_block_size)>=NewAllocSize) and + { todo: implement this also for after_block_size>0 } + (after_block_size>0) then + begin + if (before_block_size+OldAllocSize+after_block_size)=NewAllocSize then + begin + if after_block=HeapPtr then + begin + HeapPtr := HeapEnd; + if assigned(before_before_block) then + before_before_block^.Next := HeapPtr + else + FreeList := HeapPtr; + end + else + if assigned(before_before_block) then + before_before_block^.Next := after_block^.Next + else + FreeList := after_block^.Next; + end; + Result := Pointer(TTinyHeapPointerArithmeticType(before_block)+SizeOf(TTinyHeapMemBlockSize)); + Move(p^, Result^, oldsize); + PTinyHeapMemBlockSize(before_block)^ := size; + if (before_block_size+OldAllocSize+after_block_size)>NewAllocSize then + begin + new_after_block := PTinyHeapBlock(TTinyHeapPointerArithmeticType(before_block)+NewAllocSize); + new_after_block^.Next:=after_block^.Next; + new_after_block^.Size:=EncodeTinyHeapFreeBlockSize(before_block_size+after_block_size-(NewAllocSize-OldAllocSize)); + if assigned(before_before_block) then + before_before_block^.Next := new_after_block + else + FreeList := new_after_block; + end; + FillChar((TTinyHeapPointerArithmeticType(Result)+oldsize)^, size-oldsize, 0); + p := Result; + end + else + begin + result := AllocMem(size); + if result <> nil then + begin + if oldsize > size then + oldsize := size; + move(pbyte(p)^, pbyte(result)^, oldsize); + end; + SysTinyFreeMem(p); + p := result; + end; + end; end; end; - SysTinyFreeMem(p); - p := result; {$ifdef DEBUG_TINY_HEAP} - Writeln(ptruint(result)); + Writeln(HexStr(result)); +{$endif DEBUG_TINY_HEAP} + end; + + function MemAvail: {$ifdef FPC_TINYHEAP_HUGE}LongInt{$else}PtrUInt{$endif}; + var + p: PTinyHeapBlock; + begin + MemAvail := PtrUInt(TTinyHeapPointerArithmeticType(HeapEnd)-TTinyHeapPointerArithmeticType(HeapPtr)); + if MemAvail > 0 then + Dec(MemAvail, SizeOf(TTinyHeapMemBlockSize)); + + p := FreeList; + while p <> HeapPtr do + begin + Inc(MemAvail, DecodeTinyHeapFreeBlockSize(p^.Size)-SizeOf(TTinyHeapMemBlockSize)); + p := p^.Next; + end; + end; + + function MaxAvail: {$ifdef FPC_TINYHEAP_HUGE}LongInt{$else}PtrUInt{$endif}; + var + p: PTinyHeapBlock; + begin + MaxAvail := PtrUInt(TTinyHeapPointerArithmeticType(HeapEnd)-TTinyHeapPointerArithmeticType(HeapPtr)); + + p := FreeList; + while p <> HeapPtr do + begin + if DecodeTinyHeapFreeBlockSize(p^.Size) > MaxAvail then + MaxAvail := DecodeTinyHeapFreeBlockSize(p^.Size); + p := p^.Next; + end; + + if MaxAvail > 0 then + Dec(MaxAvail, SizeOf(TTinyHeapMemBlockSize)); + end; + + procedure Mark(var p: Pointer); + begin + p := HeapPtr; + end; + + procedure Release(var p: Pointer); + begin + HeapPtr := p; + FreeList := p; + end; + + procedure InternalTinyAlign(var AAddress: Pointer; ASize: PtrUInt); + var + alignment_inc: smallint; + begin + alignment_inc := TTinyHeapPointerArithmeticType(align(AAddress,TinyHeapAllocGranularity))-TTinyHeapPointerArithmeticType(AAddress); + Inc(AAddress,alignment_inc); + Dec(ASize,alignment_inc); + Dec(ASize,ASize mod TinyHeapAllocGranularity); + end; + + { Strongly simplified version of RegisterTinyHeapBlock, which can be used when + the heap is only a single contiguous memory block. If you want to add + multiple blocks to the heap, you should use RegisterTinyHeapBlock instead. } + procedure RegisterTinyHeapBlock_Simple(AAddress: Pointer; ASize: PtrUInt); + begin +{$ifdef DEBUG_TINY_HEAP} + Writeln('RegisterTinyHeapBlock_Simple(', HexStr(AAddress), ',', ASize, ')'); +{$endif DEBUG_TINY_HEAP} + InternalTinyAlign(AAddress, ASize); + HeapOrg:=AAddress; + HeapPtr:=AAddress; + FreeList:=AAddress; + HeapEnd:=Pointer(TTinyHeapPointerArithmeticType(AAddress)+ASize); + end; + + { Strongly simplified version of RegisterTinyHeapBlock, which can be used when + the heap is only a single contiguous memory block and the address and size + are already aligned on a TinyHeapAllocGranularity boundary. } + procedure RegisterTinyHeapBlock_Simple_Prealigned(AAddress: Pointer; ASize: PtrUInt); + begin +{$ifdef DEBUG_TINY_HEAP} + Writeln('RegisterTinyHeapBlock_Simple_Prealigned(', HexStr(AAddress), ',', ASize, ')'); {$endif DEBUG_TINY_HEAP} + HeapOrg:=AAddress; + HeapPtr:=AAddress; + FreeList:=AAddress; + HeapEnd:=Pointer(TTinyHeapPointerArithmeticType(AAddress)+ASize); end; procedure RegisterTinyHeapBlock(AAddress: pointer; ASize: ptruint); + var + alignment_inc: smallint; + p: PTinyHeapBlock; begin {$ifdef DEBUG_TINY_HEAP} - Writeln('RegisterTinyHeapBlock(', ptruint(AAddress), ',', ASize, ')'); + Writeln('RegisterTinyHeapBlock(', HexStr(AAddress), ',', ASize, ')'); {$endif DEBUG_TINY_HEAP} - if (ptruint(AAddress) and 1) <> 0 then + InternalTinyAlign(AAddress, ASize); + if HeapOrg=nil then + begin + HeapOrg:=AAddress; + HeapPtr:=AAddress; + FreeList:=AAddress; + HeapEnd:=Pointer(TTinyHeapPointerArithmeticType(AAddress)+ASize); + end + else begin - Inc(AAddress); - Dec(ASize); + if (TTinyHeapPointerArithmeticType(HeapOrg) > TTinyHeapPointerArithmeticType(AAddress)) then + HeapOrg:=AAddress; + if TTinyHeapPointerArithmeticType(AAddress) > TTinyHeapPointerArithmeticType(HeapEnd) then + begin + if TTinyHeapPointerArithmeticType(HeapPtr) = TTinyHeapPointerArithmeticType(HeapEnd) then + begin + if FreeList=HeapPtr then + FreeList:=AAddress + else + begin + p:=FreeList; + while p^.Next<>HeapPtr do + p:=p^.Next; + PTinyHeapBlock(HeapPtr)^.Next:=AAddress; + end; + end + else + begin + PTinyHeapBlock(HeapPtr)^.Size:=EncodeTinyHeapFreeBlockSize(TTinyHeapPointerArithmeticType(HeapEnd)-TTinyHeapPointerArithmeticType(HeapPtr)); + PTinyHeapBlock(HeapPtr)^.Next:=AAddress; + end; + HeapPtr:=AAddress; + HeapEnd:=Pointer(TTinyHeapPointerArithmeticType(AAddress)+ASize); + end + else if TTinyHeapPointerArithmeticType(AAddress) = TTinyHeapPointerArithmeticType(HeapEnd) then + HeapEnd:=Pointer(TTinyHeapPointerArithmeticType(AAddress)+ASize) + else + InternalTinyFreeMem(AAddress, ASize); end; - if (ASize and 1) <> 0 then - Dec(ASize); - pptruint(AAddress)^ := ASize - SizeOf(ptruint); - FreeMem(pptruint(AAddress) + 1, ASize - SizeOf(ptruint)); end; const |