paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-13 11:39:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ heapblocks

Browse Source
This commit is contained in:
peter 1998-04-21 10:22:48 +00:00
parent 6fb9e55bb3
commit e4328d08e2
2 changed files with 26 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
rtl/i386/heap.inc
View File

@ -58,20 +58,16 @@
_heapsize : longint; _heapsize : longint;
type type
{$ifdef UseBlocks}
tblocks = array[1..maxblock] of pointer; tblocks = array[1..maxblock] of pointer;
pblocks = ^tblocks; pblocks = ^tblocks;
tnblocks = array[1..maxblock] of longint; tnblocks = array[1..maxblock] of longint;
pnblocks = ^tnblocks; pnblocks = ^tnblocks;
{$endif UseBlocks}
pheapinfo = ^theapinfo; pheapinfo = ^theapinfo;
theapinfo = record theapinfo = record
heaporg,heapptr,heapend,freelist : pointer; heaporg,heapptr,heapend,freelist : pointer;
memavail,heapsize : longint; memavail,heapsize : longint;
{$ifdef UseBlocks}
block : pblocks; block : pblocks;
nblock : pnblocks; nblock : pnblocks;
{$endif UseBlocks}
{$IfDef CHECKHEAP} {$IfDef CHECKHEAP}
last_mem : pheap_mem_info; last_mem : pheap_mem_info;
nb_get,nb_free : longint; nb_get,nb_free : longint;
@ -93,10 +89,8 @@
otherheap : pheapinfo; otherheap : pheapinfo;
{$endif TEMPHEAP} {$endif TEMPHEAP}
{$ifdef UseBlocks}
baseblocks : tblocks; baseblocks : tblocks;
basenblocks : tnblocks; basenblocks : tnblocks;
{$endif UseBlocks}
{ this is not supported by FPK <v093 { this is not supported by FPK <v093
const const
@ -105,10 +99,8 @@
type type
ppointer = ^pointer; ppointer = ^pointer;
{$ifdef UseBlocks}
var blocks : pblocks; var blocks : pblocks;
nblocks : pnblocks; nblocks : pnblocks;
{$endif UseBlocks}
{$ifndef OS2} {$ifndef OS2}
@ -245,16 +237,13 @@
var var
hp : pfreerecord; hp : pfreerecord;
ma : longint; ma : longint;
{$ifdef UseBlocks}
i : longint; i : longint;
{$endif UseBlocks}
begin begin
ma:=heapend-heapptr; ma:=heapend-heapptr;
{$ifdef UseBlocks} if heapblocks then
for i:=1 to maxblock do for i:=1 to maxblock do
ma:=ma+i*8*nblocks^[i]; ma:=ma+i*8*nblocks^[i];
{$endif UseBlocks}
hp:=freelist; hp:=freelist;
while assigned(hp) do while assigned(hp) do
begin begin
@ -266,8 +255,8 @@
writeln('freerecordlist bad at end ') writeln('freerecordlist bad at end ')
end end
else else
if ((longint(hp^.next)<=(longint(hp)+hp^.size)) or if ((longint(hp^.next)<=(longint(hp)+hp^.size)) or
((hp^.size and 7) <> 0)) then ((hp^.size and 7) <> 0)) then
writeln('error in freerecord list '); writeln('error in freerecord list ');
{$EndIf CHECKHEAP} {$EndIf CHECKHEAP}
hp:=hp^.next; hp:=hp^.next;
@ -526,9 +515,7 @@
var var
last,hp : pfreerecord; last,hp : pfreerecord;
nochmal : boolean; nochmal : boolean;
{$ifdef UseBlocks}
s : longint; s : longint;
{$endif}
begin begin
{$ifdef CHECKHEAP} {$ifdef CHECKHEAP}
@ -559,7 +546,8 @@
{ calc to multiply of 8 } { calc to multiply of 8 }
size:=(size+7) and not 7; size:=(size+7) and not 7;
dec(_memavail,size); dec(_memavail,size);
{$ifdef UseBlocks} if heapblocks then
begin
{ search cache } { search cache }
if size<=max_size then if size<=max_size then
begin begin
@ -567,11 +555,7 @@
if assigned(blocks^[s]) then if assigned(blocks^[s]) then
begin begin
p:=blocks^[s]; p:=blocks^[s];
{$ifdef VER0_6}
move(blocks^[s]^,blocks^[s],4);
{$else VER0_6}
blocks^[s]:=pointer(blocks^[s]^); blocks^[s]:=pointer(blocks^[s]^);
{$endif VER0_6}
dec(nblocks^[s]); dec(nblocks^[s]);
{$ifdef CHECKHEAP} {$ifdef CHECKHEAP}
goto check_new; goto check_new;
@ -580,7 +564,7 @@
{$endif CHECKHEAP} {$endif CHECKHEAP}
end; end;
end; end;
{$endif UseBlocks} end;
repeat repeat
nochmal:=false; nochmal:=false;
{ search the freelist } { search the freelist }
@ -595,9 +579,8 @@
begin begin
p:=hp; p:=hp;
{ need we the whole block ? } { need we the whole block ? }
if hp^.size>size then if (hp^.size>size) and heapblocks then
begin begin
{$ifdef UseBlocks}
{ we must check if we are still below the limit !! } { we must check if we are still below the limit !! }
if hp^.size-size<=max_size then if hp^.size-size<=max_size then
begin begin
@ -613,7 +596,6 @@
inc(nblocks^[s]); inc(nblocks^[s]);
end end
else else
{$endif UseBlocks}
begin begin
(hp+size)^.size:=hp^.size-size; (hp+size)^.size:=hp^.size-size;
(hp+size)^.next:=hp^.next; (hp+size)^.next:=hp^.next;
@ -700,9 +682,7 @@ check_new:
{$ifdef TEMPHEAP} {$ifdef TEMPHEAP}
heap_switched : boolean; heap_switched : boolean;
{$endif TEMPHEAP} {$endif TEMPHEAP}
{$ifdef UseBlocks}
s : longint; s : longint;
{$endif UseBlocks}
label freemem_exit; label freemem_exit;
begin begin
@ -779,16 +759,15 @@ check_new:
inc(_memavail,size); inc(_memavail,size);
if p+size>=heapptr then if p+size>=heapptr then
heapptr:=p heapptr:=p
{$ifdef UseBlocks}
{ insert into cache } { insert into cache }
else if size<=max_size then else
if heapblocks and (size<=max_size) then
begin begin
s:=size div 8; s:=size div 8;
ppointer(p)^:=blocks^[s]; ppointer(p)^:=blocks^[s];
blocks^[s]:=p; blocks^[s]:=p;
inc(nblocks^[s]); inc(nblocks^[s]);
end end
{$endif UseBlocks}
else else
begin begin
{ size can be allways set } { size can be allways set }
@ -1017,7 +996,7 @@ begin
heapend:=pointer(NewPos+Size); heapend:=pointer(NewPos+Size);
end end
else else
begin begin
pfreerecord(NewPos)^.Size:=Size; pfreerecord(NewPos)^.Size:=Size;
pfreerecord(NewPos)^.Next:=hp^.next; pfreerecord(NewPos)^.Next:=hp^.next;
hp^.next:=pfreerecord(NewPos); hp^.next:=pfreerecord(NewPos);
@ -1049,12 +1028,9 @@ end;
{ This function will initialize the Heap manager and need to be called from { This function will initialize the Heap manager and need to be called from
the initialization of the system unit } the initialization of the system unit }
procedure InitHeap; procedure InitHeap;
{$ifdef UseBlocks}
var var
i : longint; i : longint;
{$endif UseBlocks}
begin begin
{$ifdef UseBlocks}
Blocks:=@baseblocks; Blocks:=@baseblocks;
Nblocks:=@basenblocks; Nblocks:=@basenblocks;
for i:=1 to maxblock do for i:=1 to maxblock do
@ -1062,7 +1038,6 @@ begin
Blocks^[i]:=nil; Blocks^[i]:=nil;
Nblocks^[i]:=0; Nblocks^[i]:=0;
end; end;
{$endif UseBlocks}
Curheap := @baseheap; Curheap := @baseheap;
{$ifdef TEMPHEAP} {$ifdef TEMPHEAP}
Otherheap := @tempheap; Otherheap := @tempheap;
@ -1078,7 +1053,10 @@ end;
{ {
$Log$ $Log$
Revision 1.3 1998-04-09 08:32:14 daniel Revision 1.4 1998-04-21 10:22:48 peter
+ heapblocks
Revision 1.3 1998/04/09 08:32:14 daniel
* Optimized some code. * Optimized some code.
Revision 1.2 1998/03/31 19:01:41 daniel Revision 1.2 1998/03/31 19:01:41 daniel
@ -1091,7 +1069,7 @@ end;
+ Added log at the end + Added log at the end
Working file: rtl/i386/heap.inc Working file: rtl/i386/heap.inc
description: description:
---------------------------- ----------------------------

14
rtl/inc/heaph.inc
View File

@ -12,6 +12,10 @@
**********************************************************************} **********************************************************************}
const
heapblocks : boolean=false;
var var
heaporg,heapptr,heapend,heaperror,freelist : pointer; heaporg,heapptr,heapend,heaperror,freelist : pointer;
@ -35,14 +39,18 @@
{ {
$Log$ $Log$
Revision 1.1 1998-03-25 11:18:43 root Revision 1.2 1998-04-21 10:23:15 peter
Initial revision + heapblocks
Revision 1.1.1.1 1998/03/25 11:18:43 root
* Restored version
Revision 1.3 1998/01/26 11:59:33 michael Revision 1.3 1998/01/26 11:59:33 michael
+ Added log at the end + Added log at the end
Working file: rtl/inc/heaph.inc Working file: rtl/inc/heaph.inc
description: description:
---------------------------- ----------------------------