* new heapalloc calls, patch from Thomas Schatzl

This commit is contained in:
peter 2000-09-04 19:36:59 +00:00
parent ada4ad7c98
commit 14d80c46e2

View File

@ -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
} }