1{ 2 This file is part of the Free Pascal run time library. 3 Copyright (c) 2011 by the Free Pascal development team. 4 5 Tiny heap manager for the i8086 near heap, embedded targets, etc. 6 7 See the file COPYING.FPC, included in this distribution, 8 for details about the copyright. 9 10 This program is distributed in the hope that it will be useful, 11 but WITHOUT ANY WARRANTY; without even the implied warranty of 12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 13 14 **********************************************************************} 15 16{ The heap, implemented here is TP7-compatible in the i8086 far data memory 17 models. It's basically a linked list of free blocks, which are kept ordered by 18 start address. The FreeList variable points to the start of the list. Each 19 free block, except the last one, contains a TTinyHeapBlock structure, which 20 holds the block size and a pointer to the next free block. The HeapPtr 21 variable points to the last free block, indicating the end of the list. The 22 last block is special in that it doesn't contain a TTinyHeapBlock structure. 23 Instead its size is determined by the pointer difference (HeapEnd-HeapPtr). 24 It *can* become zero sized, when all the memory inside of it is allocated, in 25 which case, HeapPtr will become equal to HeapEnd. } 26 27{$ifdef FPC_TINYHEAP_HUGE} 28 {$HugePointerArithmeticNormalization On} 29 {$HugePointerComparisonNormalization On} 30{$endif FPC_TINYHEAP_HUGE} 31 32 type 33 { TTinyHeapMemBlockSize holds the size of an *allocated* memory block, 34 and is written at position: 35 memblockstart-sizeof(TTinyHeapMemBlockSize) } 36 PTinyHeapMemBlockSize = ^TTinyHeapMemBlockSize; {$ifdef FPC_TINYHEAP_HUGE}huge;{$endif} 37 TTinyHeapMemBlockSize = PtrUInt; 38 39 { TTinyHeapFreeBlockSize holds the size of a *free* memory block, as a 40 part of the TTinyHeapBlock structure } 41{$ifdef FPC_TINYHEAP_HUGE} 42 TTinyHeapFreeBlockSize = record 43 OfsSize: Word; 44 SegSize: Word; 45 end; 46{$else FPC_TINYHEAP_HUGE} 47 TTinyHeapFreeBlockSize = PtrUInt; 48{$endif FPC_TINYHEAP_HUGE} 49 50 TTinyHeapPointerArithmeticType = ^Byte; {$ifdef FPC_TINYHEAP_HUGE}huge;{$endif} 51 52 PTinyHeapBlock = ^TTinyHeapBlock; 53 TTinyHeapBlock = record 54 Next: PTinyHeapBlock; 55 Size: TTinyHeapFreeBlockSize; 56 end; 57 58 const 59 TinyHeapMinBlock = sizeof(TTinyHeapBlock); 60 61 TinyHeapAllocGranularity = sizeof(TTinyHeapBlock); 62 63 procedure RegisterTinyHeapBlock(AAddress: Pointer; ASize:{$ifdef FPC_TINYHEAP_HUGE}LongInt{$else}PtrUInt{$endif}); forward; 64 65 function EncodeTinyHeapFreeBlockSize(Size: PtrUInt): TTinyHeapFreeBlockSize; inline; 66 begin 67{$ifdef FPC_TINYHEAP_HUGE} 68 EncodeTinyHeapFreeBlockSize.OfsSize := Size and 15; 69 EncodeTinyHeapFreeBlockSize.SegSize := Size shr 4; 70{$else FPC_TINYHEAP_HUGE} 71 EncodeTinyHeapFreeBlockSize := Size; 72{$endif FPC_TINYHEAP_HUGE} 73 end; 74 75 function DecodeTinyHeapFreeBlockSize(Size: TTinyHeapFreeBlockSize): PtrUInt; inline; 76 begin 77{$ifdef FPC_TINYHEAP_HUGE} 78 DecodeTinyHeapFreeBlockSize := (PtrUInt(Size.SegSize) shl 4) + Size.OfsSize; 79{$else FPC_TINYHEAP_HUGE} 80 DecodeTinyHeapFreeBlockSize := Size; 81{$endif FPC_TINYHEAP_HUGE} 82 end; 83 84 procedure InternalTinyFreeMem(Addr: Pointer; Size: PtrUInt); forward; 85 86 function FindSize(p: pointer): TTinyHeapMemBlockSize; 87 begin 88 FindSize := PTinyHeapMemBlockSize(p)[-1]; 89 end; 90 91 function SysGetMem(Size: ptruint): pointer; 92 var 93 p, prev, p2: PTinyHeapBlock; 94 AllocSize, RestSize: ptruint; 95 begin 96{$ifdef DEBUG_TINY_HEAP} 97 Write('SysGetMem(', Size, ')='); 98{$endif DEBUG_TINY_HEAP} 99 AllocSize := align(size+sizeof(TTinyHeapMemBlockSize), TinyHeapAllocGranularity); 100 101 p := FreeList; 102 prev := nil; 103 while (p<>HeapPtr) and (DecodeTinyHeapFreeBlockSize(p^.Size) < AllocSize) do 104 begin 105 prev := p; 106 p := p^.Next; 107 end; 108 109 if p<>HeapPtr then 110 begin 111 result := @PTinyHeapMemBlockSize(p)[1]; 112 113 if DecodeTinyHeapFreeBlockSize(p^.Size)-AllocSize >= TinyHeapMinBlock then 114 RestSize := DecodeTinyHeapFreeBlockSize(p^.Size)-AllocSize 115 else 116 begin 117 AllocSize := DecodeTinyHeapFreeBlockSize(p^.Size); 118 RestSize := 0; 119 end; 120 121 if RestSize > 0 then 122 begin 123 p2 := pointer(TTinyHeapPointerArithmeticType(p)+AllocSize); 124 p2^.Next := p^.Next; 125 p2^.Size := EncodeTinyHeapFreeBlockSize(RestSize); 126 if prev = nil then 127 FreeList := p2 128 else 129 prev^.next := p2; 130 end 131 else 132 begin 133 if prev = nil then 134 FreeList := p^.Next 135 else 136 prev^.next := p^.next; 137 end; 138 139 PTinyHeapMemBlockSize(p)^ := size; 140 end 141 else 142 begin 143 { p=HeapPtr } 144 if PtrUInt(TTinyHeapPointerArithmeticType(HeapEnd)-TTinyHeapPointerArithmeticType(HeapPtr))<AllocSize then 145 begin 146 { align to 16 bytes } 147 AllocSize:= (AllocSize + $f) and (not $f); 148 p:=SysOSAlloc(AllocSize); 149 if assigned(p) then 150 begin 151 { This needs toi be fixed because 152 HeapEnd and HeapSize are not updated correctly 153 if p > HeapPtr then 154 begin 155 prev:=HeapPtr; 156 HeapPtr:=p; 157 end 158 else } 159 begin 160{$ifdef DEBUG_TINY_HEAP} 161 Writeln('SysAlloc returned: ',HexStr(p)); 162{$endif DEBUG_TINY_HEAP} 163 RegisterTinyHeapBlock(p,AllocSize); 164 { Recursive call } 165 SysGetMem:=SysGetMem(Size); 166 exit; 167 end; 168 end 169 else 170 begin 171 if ReturnNilIfGrowHeapFails then 172 begin 173 Result := nil; 174 exit; 175 end 176 else 177 HandleError(203); 178 end; 179 end; 180 result := @PTinyHeapMemBlockSize(HeapPtr)[1]; 181 PTinyHeapMemBlockSize(HeapPtr)^ := size; 182 183 HeapPtr := pointer(TTinyHeapPointerArithmeticType(HeapPtr)+AllocSize); 184 if prev = nil then 185 FreeList := HeapPtr 186 else 187 prev^.next := HeapPtr; 188 end; 189{$ifdef DEBUG_TINY_HEAP} 190 Writeln(HexStr(Result)); 191{$endif DEBUG_TINY_HEAP} 192 end; 193 194 function TinyGetAlignedMem(Size, Alignment: ptruint): pointer; 195 var 196 mem: Pointer; 197 memp: ptruint; 198 begin 199 if alignment <= sizeof(pointer) then 200 result := GetMem(size) 201 else 202 begin 203 mem := GetMem(Size+Alignment-1); 204 memp := align(ptruint(mem), Alignment); 205 InternalTinyFreeMem(mem, TTinyHeapPointerArithmeticType(memp)-TTinyHeapPointerArithmeticType(mem)); 206 result := pointer(memp); 207 end; 208 end; 209 210 procedure InternalTinyFreeMem(Addr: Pointer; Size: PtrUInt); 211 var 212 p, prev: PTinyHeapBlock; 213 begin 214 p := FreeList; 215 prev := nil; 216 217 while (p<>HeapPtr) and (TTinyHeapPointerArithmeticType(p) < TTinyHeapPointerArithmeticType(Addr)) do 218 begin 219 prev := p; 220 p := p^.Next; 221 end; 222 223 { join with previous block? } 224 if assigned(prev) and ((TTinyHeapPointerArithmeticType(prev)+DecodeTinyHeapFreeBlockSize(prev^.Size)) = TTinyHeapPointerArithmeticType(Addr)) then 225 begin 226 Addr:=prev; 227 Size:=DecodeTinyHeapFreeBlockSize(prev^.size)+Size; 228 end 229 else 230 if assigned(prev) then 231 prev^.Next := Addr 232 else 233 FreeList := Addr; 234 235 { join with next block? } 236 if TTinyHeapPointerArithmeticType(p)=(TTinyHeapPointerArithmeticType(Addr)+Size) then 237 begin 238 if p=HeapPtr then 239 HeapPtr:=Addr 240 else 241 begin 242 PTinyHeapBlock(Addr)^.Next:=p^.Next; 243 PTinyHeapBlock(Addr)^.Size:=EncodeTinyHeapFreeBlockSize(Size+DecodeTinyHeapFreeBlockSize(p^.Size)); 244 end; 245 end 246 else 247 begin 248 PTinyHeapBlock(Addr)^.Next:=p; 249 PTinyHeapBlock(Addr)^.Size:=EncodeTinyHeapFreeBlockSize(Size); 250 end; 251 end; 252 253 function SysFreeMem(p: Pointer): ptruint; 254 var 255 sz: ptruint; 256 begin 257{$ifdef DEBUG_TINY_HEAP} 258 Writeln('SysFreeMem(', HexStr(p), ')'); 259{$endif DEBUG_TINY_HEAP} 260 if p=nil then 261 begin 262 result:=0; 263 exit; 264 end; 265 if (TTinyHeapPointerArithmeticType(p) < TTinyHeapPointerArithmeticType(HeapOrg)) or 266 (TTinyHeapPointerArithmeticType(p) >= TTinyHeapPointerArithmeticType(HeapPtr)) then 267 HandleError(204); 268 sz := Align(FindSize(p)+SizeOf(TTinyHeapMemBlockSize), TinyHeapAllocGranularity); 269 270 InternalTinyFreeMem(@PTinyHeapMemBlockSize(p)[-1], sz); 271 272 result := sz; 273 end; 274 275 function SysFreeMemSize(p: Pointer; Size: Ptruint): ptruint; 276 begin 277 result := SysFreeMem(p); 278 end; 279 280 function SysMemSize(p: pointer): ptruint; 281 begin 282 result := findsize(p); 283 end; 284 285 function SysTryResizeMem(var p: pointer; size: ptruint) : boolean; 286 begin 287 result := false; 288 end; 289 290 function SysAllocMem(size: ptruint): pointer; 291 begin 292 result := SysGetMem(size); 293 if result<>nil then 294 FillChar(result^,SysMemSize(result),0); 295 end; 296 297 function SysReAllocMem(var p: pointer; size: ptruint):pointer; 298 var 299 oldsize, OldAllocSize, NewAllocSize: ptruint; 300 after_block, before_block, before_before_block: PTinyHeapBlock; 301 after_block_size, before_block_size: PtrUInt; 302 new_after_block: PTinyHeapBlock; 303 begin 304{$ifdef DEBUG_TINY_HEAP} 305 Write('SysReAllocMem(', HexStr(p), ',', size, ')='); 306{$endif DEBUG_TINY_HEAP} 307 if size=0 then 308 begin 309 SysFreeMem(p); 310 result := nil; 311 p := nil; 312 end 313 else if p=nil then 314 begin 315 result := AllocMem(size); 316 p := result; 317 end 318 else 319 begin 320 if (TTinyHeapPointerArithmeticType(p) < TTinyHeapPointerArithmeticType(HeapOrg)) or 321 (TTinyHeapPointerArithmeticType(p) >= TTinyHeapPointerArithmeticType(HeapPtr)) then 322 HandleError(204); 323 oldsize := FindSize(p); 324 OldAllocSize := align(oldsize+sizeof(TTinyHeapMemBlockSize), TinyHeapAllocGranularity); 325 NewAllocSize := align(size+sizeof(TTinyHeapMemBlockSize), TinyHeapAllocGranularity); 326 if OldAllocSize = NewAllocSize then 327 begin 328 { old and new size are the same after alignment, so the memory block is already allocated } 329 { we just need to update the size } 330 PTinyHeapMemBlockSize(p)[-1] := size; 331 if size > oldsize then 332 FillChar((TTinyHeapPointerArithmeticType(p)+oldsize)^, size-oldsize, 0); 333 end 334 else if OldAllocSize > NewAllocSize then 335 begin 336 { we're decreasing the memory block size, so we can just free the remaining memory at the end } 337 PTinyHeapMemBlockSize(p)[-1] := size; 338 InternalTinyFreeMem(Pointer(TTinyHeapPointerArithmeticType(p)+(NewAllocSize-PtrUInt(SizeOf(TTinyHeapMemBlockSize)))), OldAllocSize-NewAllocSize); 339 end 340 else 341 begin 342 { we're increasing the memory block size. First, find if there are free memory blocks immediately 343 before and after our memory block. } 344 after_block := FreeList; 345 before_block := nil; 346 before_before_block := nil; 347 while (after_block<>HeapPtr) and (TTinyHeapPointerArithmeticType(after_block) < TTinyHeapPointerArithmeticType(p)) do 348 begin 349 before_before_block := before_block; 350 before_block := after_block; 351 after_block := after_block^.Next; 352 end; 353 { is after_block immediately after our block? } 354 if after_block=Pointer(TTinyHeapPointerArithmeticType(p)+(OldAllocSize-PtrUInt(SizeOf(TTinyHeapMemBlockSize)))) then 355 begin 356 if after_block = HeapPtr then 357 after_block_size := PtrUInt(TTinyHeapPointerArithmeticType(HeapEnd)-TTinyHeapPointerArithmeticType(HeapPtr)) 358 else 359 after_block_size := DecodeTinyHeapFreeBlockSize(after_block^.size); 360 end 361 else 362 after_block_size := 0; 363 { is there enough room after the block? } 364 if (OldAllocSize+after_block_size)>=NewAllocSize then 365 begin 366 if after_block = HeapPtr then 367 begin 368 HeapPtr:=Pointer(TTinyHeapPointerArithmeticType(HeapPtr)+(NewAllocSize-OldAllocSize)); 369 if assigned(before_block) then 370 before_block^.Next := HeapPtr 371 else 372 FreeList := HeapPtr; 373 end 374 else 375 begin 376 if (NewAllocSize-OldAllocSize)=after_block_size then 377 begin 378 if assigned(before_block) then 379 before_block^.Next := after_block^.Next 380 else 381 FreeList := after_block^.Next; 382 end 383 else 384 begin 385 new_after_block := PTinyHeapBlock(TTinyHeapPointerArithmeticType(after_block)+(NewAllocSize-OldAllocSize)); 386 new_after_block^.Next:=after_block^.Next; 387 new_after_block^.Size:=EncodeTinyHeapFreeBlockSize(after_block_size-(NewAllocSize-OldAllocSize)); 388 if assigned(before_block) then 389 before_block^.Next := new_after_block 390 else 391 FreeList := new_after_block; 392 end; 393 end; 394 PTinyHeapMemBlockSize(p)[-1] := size; 395 FillChar((TTinyHeapPointerArithmeticType(p)+oldsize)^, size-oldsize, 0); 396 end 397 else 398 begin 399 { is before_block immediately before our block? } 400 if assigned(before_block) and (Pointer(TTinyHeapPointerArithmeticType(before_block)+DecodeTinyHeapFreeBlockSize(before_block^.Size))=Pointer(TTinyHeapPointerArithmeticType(p)-SizeOf(TTinyHeapMemBlockSize))) then 401 before_block_size := DecodeTinyHeapFreeBlockSize(before_block^.Size) 402 else 403 before_block_size := 0; 404 405 { if there's enough space, we can slide our current block back and reclaim before_block } 406 if (before_block_size<NewAllocSize) and ((before_block_size+OldAllocSize+after_block_size)>=NewAllocSize) and 407 { todo: implement this also for after_block_size>0 } 408 (after_block_size>0) then 409 begin 410 if (before_block_size+OldAllocSize+after_block_size)=NewAllocSize then 411 begin 412 if after_block=HeapPtr then 413 begin 414 HeapPtr := HeapEnd; 415 if assigned(before_before_block) then 416 before_before_block^.Next := HeapPtr 417 else 418 FreeList := HeapPtr; 419 end 420 else 421 if assigned(before_before_block) then 422 before_before_block^.Next := after_block^.Next 423 else 424 FreeList := after_block^.Next; 425 end; 426 Result := Pointer(TTinyHeapPointerArithmeticType(before_block)+SizeOf(TTinyHeapMemBlockSize)); 427 Move(p^, Result^, oldsize); 428 PTinyHeapMemBlockSize(before_block)^ := size; 429 if (before_block_size+OldAllocSize+after_block_size)>NewAllocSize then 430 begin 431 new_after_block := PTinyHeapBlock(TTinyHeapPointerArithmeticType(before_block)+NewAllocSize); 432 new_after_block^.Next:=after_block^.Next; 433 new_after_block^.Size:=EncodeTinyHeapFreeBlockSize(before_block_size+after_block_size-(NewAllocSize-OldAllocSize)); 434 if assigned(before_before_block) then 435 before_before_block^.Next := new_after_block 436 else 437 FreeList := new_after_block; 438 end; 439 FillChar((TTinyHeapPointerArithmeticType(Result)+oldsize)^, size-oldsize, 0); 440 p := Result; 441 end 442 else 443 begin 444 result := AllocMem(size); 445 if result <> nil then 446 begin 447 if oldsize > size then 448 oldsize := size; 449 move(pbyte(p)^, pbyte(result)^, oldsize); 450 end; 451 SysFreeMem(p); 452 p := result; 453 end; 454 end; 455 end; 456 end; 457{$ifdef DEBUG_TINY_HEAP} 458 Writeln(HexStr(result)); 459{$endif DEBUG_TINY_HEAP} 460 end; 461 462 function MemAvail: {$ifdef FPC_TINYHEAP_HUGE}LongInt{$else}PtrUInt{$endif}; 463 var 464 p: PTinyHeapBlock; 465 begin 466 MemAvail := PtrUInt(TTinyHeapPointerArithmeticType(HeapEnd)-TTinyHeapPointerArithmeticType(HeapPtr)); 467 if MemAvail > 0 then 468 Dec(MemAvail, SizeOf(TTinyHeapMemBlockSize)); 469 470 p := FreeList; 471 while p <> HeapPtr do 472 begin 473 Inc(MemAvail, DecodeTinyHeapFreeBlockSize(p^.Size)-SizeOf(TTinyHeapMemBlockSize)); 474 p := p^.Next; 475 end; 476 end; 477 478 function MaxAvail: {$ifdef FPC_TINYHEAP_HUGE}LongInt{$else}PtrUInt{$endif}; 479 var 480 p: PTinyHeapBlock; 481 begin 482 MaxAvail := PtrUInt(TTinyHeapPointerArithmeticType(HeapEnd)-TTinyHeapPointerArithmeticType(HeapPtr)); 483 484 p := FreeList; 485 while p <> HeapPtr do 486 begin 487 if DecodeTinyHeapFreeBlockSize(p^.Size) > MaxAvail then 488 MaxAvail := DecodeTinyHeapFreeBlockSize(p^.Size); 489 p := p^.Next; 490 end; 491 492 if MaxAvail > 0 then 493 Dec(MaxAvail, SizeOf(TTinyHeapMemBlockSize)); 494 end; 495 496 procedure Mark(var p: Pointer); 497 begin 498 p := HeapPtr; 499 end; 500 501 procedure Release(var p: Pointer); 502 begin 503 HeapPtr := p; 504 FreeList := p; 505 end; 506 507 procedure InternalTinyAlign(var AAddress: Pointer; var ASize: {$ifdef FPC_TINYHEAP_HUGE}LongInt{$else}PtrUInt{$endif}); 508 var 509 alignment_inc: smallint; 510 begin 511 alignment_inc := TTinyHeapPointerArithmeticType(align(AAddress,TinyHeapAllocGranularity))-TTinyHeapPointerArithmeticType(AAddress); 512 Inc(AAddress,alignment_inc); 513 Dec(ASize,alignment_inc); 514 Dec(ASize,ASize mod TinyHeapAllocGranularity); 515 end; 516 517 { Strongly simplified version of RegisterTinyHeapBlock, which can be used when 518 the heap is only a single contiguous memory block. If you want to add 519 multiple blocks to the heap, you should use RegisterTinyHeapBlock instead. } 520 procedure RegisterTinyHeapBlock_Simple(AAddress: Pointer; ASize:{$ifdef FPC_TINYHEAP_HUGE}LongInt{$else}PtrUInt{$endif}); 521 begin 522{$ifdef DEBUG_TINY_HEAP} 523 Writeln('RegisterTinyHeapBlock_Simple(', HexStr(AAddress), ',', ASize, ')'); 524{$endif DEBUG_TINY_HEAP} 525 InternalTinyAlign(AAddress, ASize); 526 HeapSize:=HeapSize + ASize; 527 HeapOrg:=AAddress; 528 HeapPtr:=AAddress; 529 FreeList:=AAddress; 530 HeapEnd:=Pointer(TTinyHeapPointerArithmeticType(AAddress)+ASize); 531 end; 532 533 { Strongly simplified version of RegisterTinyHeapBlock, which can be used when 534 the heap is only a single contiguous memory block and the address and size 535 are already aligned on a TinyHeapAllocGranularity boundary. } 536 procedure RegisterTinyHeapBlock_Simple_Prealigned(AAddress: Pointer; ASize: {$ifdef FPC_TINYHEAP_HUGE}LongInt{$else}PtrUInt{$endif}); 537 begin 538{$ifdef DEBUG_TINY_HEAP} 539 Writeln('RegisterTinyHeapBlock_Simple_Prealigned(', HexStr(AAddress), ',', ASize, ')'); 540{$endif DEBUG_TINY_HEAP} 541 HeapOrg:=AAddress; 542 HeapPtr:=AAddress; 543 FreeList:=AAddress; 544 HeapSize:=HeapSize + ASize; 545 HeapEnd:=Pointer(TTinyHeapPointerArithmeticType(AAddress)+ASize); 546 end; 547 548 procedure RegisterTinyHeapBlock(AAddress: pointer; ASize: {$ifdef FPC_TINYHEAP_HUGE}LongInt{$else}PtrUInt{$endif}); 549 var 550 alignment_inc: smallint; 551 p: PTinyHeapBlock; 552 begin 553{$ifdef DEBUG_TINY_HEAP} 554 Writeln('RegisterTinyHeapBlock(', HexStr(AAddress), ',', ASize, ')'); 555{$endif DEBUG_TINY_HEAP} 556 InternalTinyAlign(AAddress, ASize); 557 HeapSize:=HeapSize + ASize; 558 if HeapOrg=nil then 559 begin 560 HeapOrg:=AAddress; 561 HeapPtr:=AAddress; 562 FreeList:=AAddress; 563 HeapEnd:=Pointer(TTinyHeapPointerArithmeticType(AAddress)+ASize); 564 end 565 else 566 begin 567 if (TTinyHeapPointerArithmeticType(HeapOrg) > TTinyHeapPointerArithmeticType(AAddress)) then 568 HeapOrg:=AAddress; 569 if TTinyHeapPointerArithmeticType(AAddress) > TTinyHeapPointerArithmeticType(HeapEnd) then 570 begin 571 if TTinyHeapPointerArithmeticType(HeapPtr) = TTinyHeapPointerArithmeticType(HeapEnd) then 572 begin 573 if FreeList=HeapPtr then 574 FreeList:=AAddress 575 else 576 begin 577 p:=FreeList; 578 while p^.Next<>HeapPtr do 579 p:=p^.Next; 580 PTinyHeapBlock(p)^.Next:=AAddress; 581 end; 582 end 583 else 584 begin 585 PTinyHeapBlock(HeapPtr)^.Size:=EncodeTinyHeapFreeBlockSize(TTinyHeapPointerArithmeticType(HeapEnd)-TTinyHeapPointerArithmeticType(HeapPtr)); 586 PTinyHeapBlock(HeapPtr)^.Next:=AAddress; 587 end; 588 HeapPtr:=AAddress; 589 HeapEnd:=Pointer(TTinyHeapPointerArithmeticType(AAddress)+ASize); 590 end 591 else if TTinyHeapPointerArithmeticType(AAddress) = TTinyHeapPointerArithmeticType(HeapEnd) then 592 HeapEnd:=Pointer(TTinyHeapPointerArithmeticType(AAddress)+ASize) 593 else 594 InternalTinyFreeMem(AAddress, ASize); 595 end; 596 end; 597 598 599 function SysGetFPCHeapStatus : TFPCHeapStatus; 600 { 601 TFPCHeapStatus = record 602 603 MaxHeapSize, 604 MaxHeapUsed, 605 CurrHeapSize, 606 CurrHeapUsed, 607 CurrHeapFree : ptruint; 608 end; 609 } 610 begin 611 SysGetFPCHeapStatus.MaxHeapSize:=MaxAvail; 612 { How can we compute this? } 613 SysGetFPCHeapStatus.MaxHeapUsed:=0; 614 SysGetFPCHeapStatus.CurrHeapFree:=MemAvail; 615 SysGetFPCHeapStatus.CurrHeapUsed:=HeapSize-SysGetFPCHeapStatus.CurrHeapFree; 616 SysGetFPCHeapStatus.CurrHeapSize:=HeapSize; 617 end; 618 619 function SysGetHeapStatus : THeapStatus; 620 begin 621 SysGetHeapStatus.TotalAddrSpace:= HeapSize; 622 SysGetHeapStatus.TotalUncommitted:= 0; 623 SysGetHeapStatus.TotalCommitted:= 0; 624 SysGetHeapStatus.TotalAllocated:= HeapSize-MemAvail; 625 SysGetHeapStatus.TotalFree:= MemAvail; 626 SysGetHeapStatus.FreeSmall:= 0; 627 SysGetHeapStatus.FreeBig:= 0; 628 SysGetHeapStatus.Unused:= 0; 629 SysGetHeapStatus.Overhead:= 0; 630 SysGetHeapStatus.HeapErrorCode:= 0; 631 end; 632 633 procedure FinalizeHeap; 634 begin 635 end; 636 637 638