mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-09 22:06:08 +02:00
* new heapalloc calls, patch from Thomas Schatzl
This commit is contained in:
parent
ada4ad7c98
commit
14d80c46e2
@ -241,16 +241,15 @@ end;
|
|||||||
{*****************************************************************************
|
{*****************************************************************************
|
||||||
Heap Management
|
Heap Management
|
||||||
*****************************************************************************}
|
*****************************************************************************}
|
||||||
|
|
||||||
{ memory functions }
|
{ memory functions }
|
||||||
function GlobalAlloc(mode,size:longint):longint;
|
function GetProcessHeap : DWord;
|
||||||
external 'kernel32' name 'GlobalAlloc';
|
external 'kernel32' name 'GetProcessHeap';
|
||||||
function GlobalLock(handle:longint):pointer;
|
function HeapAlloc(hHeap : DWord; dwFlags : DWord; dwBytes : DWord) : Longint;
|
||||||
external 'kernel32' name 'GlobalLock';
|
external 'kernel32' name 'HeapAlloc';
|
||||||
{$ifdef SYSTEMDEBUG}
|
{$IFDEF SYSTEMDEBUG}
|
||||||
function GlobalSize(h:longint):longint;
|
function HeapSize(hHeap : DWord; dwFlags : DWord; ptr : Pointer) : DWord;
|
||||||
external 'kernel32' name 'GlobalSize';
|
external 'kernel32' name 'HeapSize';
|
||||||
{$endif}
|
{$ENDIF}
|
||||||
|
|
||||||
var
|
var
|
||||||
heap : longint;external name 'HEAP';
|
heap : longint;external name 'HEAP';
|
||||||
@ -270,14 +269,13 @@ end ['EAX'];
|
|||||||
|
|
||||||
function Sbrk(size : longint):longint;
|
function Sbrk(size : longint):longint;
|
||||||
var
|
var
|
||||||
h,l : longint;
|
l : longint;
|
||||||
begin
|
begin
|
||||||
h:=GlobalAlloc(258,size);
|
l := HeapAlloc(GetProcessHeap(), 0, size);
|
||||||
l:=longint(GlobalLock(h));
|
if (l = 0) then
|
||||||
if l=0 then
|
l := -1;
|
||||||
l:=-1;
|
|
||||||
{$ifdef DUMPGROW}
|
{$ifdef DUMPGROW}
|
||||||
Writeln('new heap part at $',hexstr(l,8), ' size = ',GlobalSize(h));
|
Writeln('new heap part at $',hexstr(l,8), ' size = ',HeapSize(GetProcessHeap()));
|
||||||
{$endif}
|
{$endif}
|
||||||
sbrk:=l;
|
sbrk:=l;
|
||||||
end;
|
end;
|
||||||
@ -1324,7 +1322,10 @@ end.
|
|||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.2 2000-07-13 11:33:58 michael
|
Revision 1.3 2000-09-04 19:36:59 peter
|
||||||
|
* new heapalloc calls, patch from Thomas Schatzl
|
||||||
|
|
||||||
|
Revision 1.2 2000/07/13 11:33:58 michael
|
||||||
+ removed logs
|
+ removed logs
|
||||||
|
|
||||||
}
|
}
|
||||||
|
Loading…
Reference in New Issue
Block a user