123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642 |
- {
- This file is part of the Free Pascal run time library.
- Copyright (c) 2011 by the Free Pascal development team.
- Tiny heap manager for the i8086 near heap, embedded targets, etc.
- See the file COPYING.FPC, included in this distribution,
- for details about the copyright.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
- **********************************************************************}
- { 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
- Next: PTinyHeapBlock;
- Size: TTinyHeapFreeBlockSize;
- end;
- const
- TinyHeapMinBlock = sizeof(TTinyHeapBlock);
- TinyHeapMaxBlock = High(ptruint) - sizeof(TTinyHeapBlock) - sizeof(TTinyHeapMemBlockSize);
- TinyHeapAllocGranularity = sizeof(TTinyHeapBlock);
- procedure RegisterTinyHeapBlock(AAddress: Pointer; ASize:{$ifdef FPC_TINYHEAP_HUGE}LongInt{$else}PtrUInt{$endif}); forward;
- function EncodeTinyHeapFreeBlockSize(Size: PtrUInt): TTinyHeapFreeBlockSize; {$ifndef FPC_TINYHEAP_HUGE} inline; {$endif}
- begin
- {$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; {$ifndef FPC_TINYHEAP_HUGE} inline; {$endif}
- 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 SysGetMem(Size: ptruint): pointer;
- var
- p, prev, p2: PTinyHeapBlock;
- AllocSize, RestSize: ptruint;
- begin
- {$ifdef DEBUG_TINY_HEAP}
- Write('SysGetMem(', Size, ')=');
- {$endif DEBUG_TINY_HEAP}
- if size>TinyHeapMaxBlock then
- HandleError(203);
- AllocSize := align(size+sizeof(TTinyHeapMemBlockSize), TinyHeapAllocGranularity);
- p := FreeList;
- prev := nil;
- while (p<>HeapPtr) and (DecodeTinyHeapFreeBlockSize(p^.Size) < AllocSize) do
- begin
- prev := p;
- p := p^.Next;
- end;
- if p<>HeapPtr then
- begin
- result := @PTinyHeapMemBlockSize(p)[1];
- if DecodeTinyHeapFreeBlockSize(p^.Size)-AllocSize >= TinyHeapMinBlock then
- RestSize := DecodeTinyHeapFreeBlockSize(p^.Size)-AllocSize
- else
- begin
- AllocSize := DecodeTinyHeapFreeBlockSize(p^.Size);
- RestSize := 0;
- end;
- 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
- begin
- if prev = nil then
- FreeList := p^.Next
- else
- prev^.next := p^.next;
- end;
- PTinyHeapMemBlockSize(p)^ := size;
- end
- else
- begin
- { p=HeapPtr }
- if PtrUInt(TTinyHeapPointerArithmeticType(HeapEnd)-TTinyHeapPointerArithmeticType(HeapPtr))<AllocSize then
- begin
- { align to 16 bytes }
- AllocSize:= (AllocSize + $f) and (not $f);
- p:=SysOSAlloc(AllocSize);
- if assigned(p) then
- begin
- { This needs toi be fixed because
- HeapEnd and HeapSize are not updated correctly
- if p > HeapPtr then
- begin
- prev:=HeapPtr;
- HeapPtr:=p;
- end
- else }
- begin
- {$ifdef DEBUG_TINY_HEAP}
- Writeln('SysAlloc returned: ',HexStr(p));
- {$endif DEBUG_TINY_HEAP}
- RegisterTinyHeapBlock(p,AllocSize);
- { Recursive call }
- SysGetMem:=SysGetMem(Size);
- exit;
- end;
- end
- else
- begin
- if ReturnNilIfGrowHeapFails then
- begin
- Result := nil;
- exit;
- end
- else
- HandleError(203);
- end;
- end;
- 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(HexStr(Result));
- {$endif DEBUG_TINY_HEAP}
- end;
- function TinyGetAlignedMem(Size, Alignment: ptruint): pointer;
- var
- mem: Pointer;
- memp: ptruint;
- begin
- if alignment <= sizeof(pointer) then
- result := GetMem(size)
- else
- begin
- mem := GetMem(Size+Alignment-1);
- memp := align(ptruint(mem), Alignment);
- InternalTinyFreeMem(mem, TTinyHeapPointerArithmeticType(memp)-TTinyHeapPointerArithmeticType(mem));
- result := pointer(memp);
- end;
- end;
- procedure InternalTinyFreeMem(Addr: Pointer; Size: PtrUInt);
- var
- p, prev: PTinyHeapBlock;
- begin
- p := FreeList;
- prev := nil;
- while (p<>HeapPtr) and (TTinyHeapPointerArithmeticType(p) < TTinyHeapPointerArithmeticType(Addr)) do
- begin
- prev := p;
- p := p^.Next;
- end;
- { 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
- 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 SysFreeMem(p: Pointer): ptruint;
- var
- sz: ptruint;
- begin
- {$ifdef DEBUG_TINY_HEAP}
- Writeln('SysFreeMem(', HexStr(p), ')');
- {$endif DEBUG_TINY_HEAP}
- if p=nil then
- begin
- result:=0;
- exit;
- end;
- if (TTinyHeapPointerArithmeticType(p) < TTinyHeapPointerArithmeticType(HeapOrg)) or
- (TTinyHeapPointerArithmeticType(p) >= TTinyHeapPointerArithmeticType(HeapPtr)) then
- HandleError(204);
- sz := Align(FindSize(p)+SizeOf(TTinyHeapMemBlockSize), TinyHeapAllocGranularity);
- InternalTinyFreeMem(@PTinyHeapMemBlockSize(p)[-1], sz);
- result := sz;
- end;
- function SysFreeMemSize(p: Pointer; Size: Ptruint): ptruint;
- begin
- result := SysFreeMem(p);
- end;
- function SysMemSize(p: pointer): ptruint;
- begin
- result := findsize(p);
- end;
- function SysTryResizeMem(var p: pointer; size: ptruint) : boolean;
- begin
- result := false;
- end;
- function SysAllocMem(size: ptruint): pointer;
- begin
- result := SysGetMem(size);
- if result<>nil then
- FillChar(result^,SysMemSize(result),0);
- end;
- function SysReAllocMem(var p: pointer; size: ptruint):pointer;
- var
- 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('SysReAllocMem(', HexStr(p), ',', size, ')=');
- {$endif DEBUG_TINY_HEAP}
- if size=0 then
- begin
- SysFreeMem(p);
- result := nil;
- p := nil;
- end
- else if p=nil then
- begin
- result := AllocMem(size);
- p := result;
- end
- else
- begin
- if (TTinyHeapPointerArithmeticType(p) < TTinyHeapPointerArithmeticType(HeapOrg)) or
- (TTinyHeapPointerArithmeticType(p) >= TTinyHeapPointerArithmeticType(HeapPtr)) then
- HandleError(204);
- if size>TinyHeapMaxBlock then
- HandleError(203);
- 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
- { 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;
- SysFreeMem(p);
- p := result;
- end;
- end;
- end;
- end;
- {$ifdef DEBUG_TINY_HEAP}
- 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; var ASize: {$ifdef FPC_TINYHEAP_HUGE}LongInt{$else}PtrUInt{$endif});
- 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:{$ifdef FPC_TINYHEAP_HUGE}LongInt{$else}PtrUInt{$endif});
- begin
- {$ifdef DEBUG_TINY_HEAP}
- Writeln('RegisterTinyHeapBlock_Simple(', HexStr(AAddress), ',', ASize, ')');
- {$endif DEBUG_TINY_HEAP}
- InternalTinyAlign(AAddress, ASize);
- HeapSize:=HeapSize + 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: {$ifdef FPC_TINYHEAP_HUGE}LongInt{$else}PtrUInt{$endif});
- begin
- {$ifdef DEBUG_TINY_HEAP}
- Writeln('RegisterTinyHeapBlock_Simple_Prealigned(', HexStr(AAddress), ',', ASize, ')');
- {$endif DEBUG_TINY_HEAP}
- HeapOrg:=AAddress;
- HeapPtr:=AAddress;
- FreeList:=AAddress;
- HeapSize:=HeapSize + ASize;
- HeapEnd:=Pointer(TTinyHeapPointerArithmeticType(AAddress)+ASize);
- end;
- procedure RegisterTinyHeapBlock(AAddress: pointer; ASize: {$ifdef FPC_TINYHEAP_HUGE}LongInt{$else}PtrUInt{$endif});
- var
- alignment_inc: smallint;
- p: PTinyHeapBlock;
- begin
- {$ifdef DEBUG_TINY_HEAP}
- Writeln('RegisterTinyHeapBlock(', HexStr(AAddress), ',', ASize, ')');
- {$endif DEBUG_TINY_HEAP}
- InternalTinyAlign(AAddress, ASize);
- HeapSize:=HeapSize + ASize;
- if HeapOrg=nil then
- begin
- HeapOrg:=AAddress;
- HeapPtr:=AAddress;
- FreeList:=AAddress;
- HeapEnd:=Pointer(TTinyHeapPointerArithmeticType(AAddress)+ASize);
- end
- else
- begin
- 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(p)^.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;
- end;
- function SysGetFPCHeapStatus : TFPCHeapStatus;
- {
- TFPCHeapStatus = record
- MaxHeapSize,
- MaxHeapUsed,
- CurrHeapSize,
- CurrHeapUsed,
- CurrHeapFree : ptruint;
- end;
- }
- begin
- SysGetFPCHeapStatus.MaxHeapSize:=MaxAvail;
- { How can we compute this? }
- SysGetFPCHeapStatus.MaxHeapUsed:=0;
- SysGetFPCHeapStatus.CurrHeapFree:=MemAvail;
- SysGetFPCHeapStatus.CurrHeapUsed:=HeapSize-SysGetFPCHeapStatus.CurrHeapFree;
- SysGetFPCHeapStatus.CurrHeapSize:=HeapSize;
- end;
- function SysGetHeapStatus : THeapStatus;
- begin
- SysGetHeapStatus.TotalAddrSpace:= HeapSize;
- SysGetHeapStatus.TotalUncommitted:= 0;
- SysGetHeapStatus.TotalCommitted:= 0;
- SysGetHeapStatus.TotalAllocated:= HeapSize-MemAvail;
- SysGetHeapStatus.TotalFree:= MemAvail;
- SysGetHeapStatus.FreeSmall:= 0;
- SysGetHeapStatus.FreeBig:= 0;
- SysGetHeapStatus.Unused:= 0;
- SysGetHeapStatus.Overhead:= 0;
- SysGetHeapStatus.HeapErrorCode:= 0;
- end;
- procedure FinalizeHeap;
- begin
- end;
|