paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-28 22:40:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

* heap management modified to be able to grow heap as needed

Browse Source
This commit is contained in:
Tomas Hajny 2004-03-24 19:15:59 +00:00
parent d1069ce5a7
commit 155402e664
1 changed files with 90 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

142
rtl/os2/system.pas
View File

@ -134,10 +134,6 @@ implementation
{$I system.inc} {$I system.inc}
(* Maximum heap size - only used if heap is allocated as continuous block. *)
{$IFDEF CONTHEAP}
// BrkLimit: cardinal;
{$ENDIF CONTHEAP}
procedure DosGetInfoBlocks (PATIB: PPThreadInfoBlock; procedure DosGetInfoBlocks (PATIB: PPThreadInfoBlock;
PAPIB: PPProcessInfoBlock); cdecl; PAPIB: PPProcessInfoBlock); cdecl;
@ -487,62 +483,103 @@ function DosSetMem(P:pointer;Size,Flag:cardinal): cardinal; cdecl;
external 'DOSCALLS' index 305; external 'DOSCALLS' index 305;
var var
int_heap: pointer; Int_Heap_End: pointer;
int_heap_end: pointer; Int_Heap: pointer;
{$IFNDEF VER1_0}
external name 'HEAP';
{$ENDIF VER1_0}
Int_HeapSize: cardinal; external name 'HEAPSIZE';
PreviousHeap: cardinal;
AllocatedMemory: cardinal;
function sbrk(size:longint):pointer;
function GetHeapSize: longint;
begin
GetHeapSize := PreviousHeap + longint (Int_Heap_End) - longint (Int_Heap);
end;
function Sbrk (Size: longint): pointer;
var var
p: pointer; P: pointer;
rc: longint; RC: cardinal;
const
MemAllocBlock = 4 * 1024 * 1024;
begin begin
{$IFDEF DUMPGROW} {$IFDEF DUMPGROW}
WriteLn ('Trying to grow heap by ', Size, ' to ', HeapSize + Size); WriteLn ('Trying to grow heap by ', Size, ' to ', HeapSize + Size);
{$ENDIF} {$ENDIF}
p:=int_heap_end;
// commit memory // commit memory
rc:=DosSetMem(p, size, $13); {$WARNING Not threadsafe at the moment!}
RC := DosSetMem (Int_Heap_End, Size, $13);
{ if RC <> 0 then
Not yet working
if RC = 8 then
(* Not enough memory was allocated - let's try to allocate more (* Not enough memory was allocated - let's try to allocate more
(4 MB steps or as much as requested if more than 4 MB needed). *) (4 MB steps or as much as requested if more than 4 MB needed). *)
begin begin
if Size > 4 * 1024 * 1024 then if Size > MemAllocBlock then
RC := DosAllocMem (P, Size, 3) begin
RC := DosAllocMem (P, Size, 3);
if RC = 0 then Inc (AllocatedMemory, Size);
end
else else
RC := DosAllocMem (P, 4 * 1024 * 1024, 3); begin
RC := DosAllocMem (P, MemAllocBlock, 3);
if RC = 0 then Inc (AllocatedMemory, MemAllocBlock);
end;
if RC = 0 then if RC = 0 then
begin begin
PreviousHeap := GetHeapSize;
Int_Heap := P; Int_Heap := P;
Int_Heap_End := Int_Heap; Int_Heap_End := P;
RC := DosSetMem (P, Size, $13); RC := DosSetMem (Int_Heap_End, Size, $13);
end; end
end; else
} begin
Sbrk := nil;
if rc<>0 then p:=nil;
{$IFDEF DUMPGROW} {$IFDEF DUMPGROW}
WriteLn ('New heap at ', Cardinal(p)); WriteLn ('Error ', RC, ' during additional memory allocation!');
{$ENDIF} WriteLn ('Total allocated memory is ', cardinal (AllocatedMemory), ', ',
sbrk:=int_heap_end; GetHeapSize, ' committed.');
inc(int_heap_end, size); {$ENDIF DUMPGROW}
Exit;
end;
end; end;
function getheapstart:pointer; if RC <> 0 then
begin begin
getheapstart:=int_heap; {$IFDEF DUMPGROW}
WriteLn ('Error ', RC, ' while trying to commit more memory!');
WriteLn ('Current memory object starts at ', cardinal (Int_Heap),
' and committed until ', cardinal (Int_Heap_End));
WriteLn ('Total allocated memory is ', cardinal (AllocatedMemory), ', ',
GetHeapSize, ' committed.');
{$ENDIF DUMPGROW}
Sbrk := nil;
end
else
begin
Sbrk := Int_Heap_End;
{$IFDEF DUMPGROW}
WriteLn ('New heap at ', cardinal (Int_Heap_End));
{$ENDIF DUMPGROW}
Inc (Int_Heap_End, Size);
end;
end; end;
function getheapsize:longint;
function GetHeapStart: pointer;
begin begin
getheapsize:=longint(int_heap_end)-longint(int_heap); GetHeapStart := Int_Heap;
end; end;
{$i heap.inc} {$i heap.inc}
{**************************************************************************** {****************************************************************************
Low Level File Routines Low Level File Routines
@ -1400,6 +1437,8 @@ end;
var TIB: PThreadInfoBlock; var TIB: PThreadInfoBlock;
PIB: PProcessInfoBlock; PIB: PProcessInfoBlock;
RC: cardinal;
ErrStr: string;
begin begin
IsLibrary := FALSE; IsLibrary := FALSE;
@ -1419,27 +1458,22 @@ begin
{Initialize the heap.} {Initialize the heap.}
// Logic is following: // Logic is following:
// Application allocates maximum possible memory array (~512Mb), // Application allocates the amount of memory specified by the compiler
// but without commiting. On heap growing required amount of // switch -Ch but without commiting. On heap growing required amount of
// memory commited. So heap can be grown up to 512Mb. // memory commited. More memory is allocated as needed within sbrk.
// For newer systems maximum ammount of memory block can be
// 2 Gb, but here used 512 for campatability reasons.
// Note: Check for higher limit of heap not implemented yet.
// Note: Check for amount of memory for process not implemented yet.
// While used hard-coded value of max heapsize (256Mb)
{} RC := DosAllocMem (Int_Heap, Int_HeapSize, 3);
DosAllocMem(Int_Heap, 256*1024*1024, 3);
{
This should be changed as soon as dynamic allocation within sbrk works.
256 MB RAM is way too much - there might not be so much physical RAM and swap if RC <> 0 then
space on some systems. Let's start on 16 MB - that isn't enough for cycling begin
the compiler, of course, but more should get allocated dynamically on demand. Str (RC, ErrStr);
ErrStr := 'Error during heap initialization (' + ErrStr + ')!!';
DosAllocMem(Int_Heap, 16 * 1024 * 1024, 3); DosWrite (2, @ErrStr [1], Length (ErrStr), RC);
} HandleError (204);
end;
AllocatedMemory := Int_HeapSize;
Int_Heap_End := Int_Heap; Int_Heap_End := Int_Heap;
PreviousHeap := 0;
InitHeap; InitHeap;
{ ... and exceptions } { ... and exceptions }
@ -1463,15 +1497,15 @@ the compiler, of course, but more should get allocated dynamically on demand.
{$endif HASVARIANT} {$endif HASVARIANT}
{$IFDEF DUMPGROW} {$IFDEF DUMPGROW}
{$IFDEF CONTHEAP}
WriteLn ('Initial brk size is ', GetHeapSize); WriteLn ('Initial brk size is ', GetHeapSize);
// WriteLn ('Brk limit is ', BrkLimit);
{$ENDIF CONTHEAP}
{$ENDIF DUMPGROW} {$ENDIF DUMPGROW}
end. end.
{ {
$Log$ $Log$
Revision 1.67 2004-02-22 15:01:49 hajny Revision 1.68 2004-03-24 19:15:59 hajny
* heap management modified to be able to grow heap as needed
Revision 1.67 2004/02/22 15:01:49 hajny
* lots of fixes (regcall, THandle, string operations in sysutils, longint2cardinal according to OS/2 docs, dosh.inc, ...) * lots of fixes (regcall, THandle, string operations in sysutils, longint2cardinal according to OS/2 docs, dosh.inc, ...)
Revision 1.66 2004/02/16 22:18:44 hajny Revision 1.66 2004/02/16 22:18:44 hajny