- obsolete

rtl/win32/winheap.inc

@@ -1,129 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1998 by the Free Pascal development team.
-
-    Win32 Memory Functions
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-   { memory functions }
-   function GlobalAlloc(mode,size:longint):longint;
-     external 'kernel32' name 'GlobalAlloc';
-   function GlobalHandle(p:pointer):longint;
-     external 'kernel32' name 'GlobalHandle';
-   function GlobalLock(handle:longint):pointer;
-     external 'kernel32' name 'GlobalLock';
-   function GlobalUnlock(h:longint):longint;
-     external 'kernel32' name 'GlobalUnlock';
-   function GlobalFree(h:longint):longint;
-     external 'kernel32' name 'GlobalFree';
-   procedure GlobalMemoryStatus(p:pointer);
-     external 'kernel32' name 'GlobalMemoryStatus';
-
-
-type
-  errproc=function(size:longint):integer;
-
-procedure MemError(size:longint);
-const
-  message:pchar='Abnormal Termination';
-  caption:pchar='Memory Management Error!';
-var
-  res:integer;
-begin
-  repeat
-    res:=errproc(heaperror)(size);
-    if res=0 then
-     begin;
-       messagebox(0,caption,message,$10);
-       halt(getlasterror);
-     end;
-  until res<>2;
-end;
-
-
-procedure getmem(var p:pointer;size:longint);[public,alias: 'GETMEM'];
-begin
-  p:=GlobalLock(GlobalAlloc($102,size));
-  if p=nil then
-   memerror(size)
-end;
-
-
-procedure freemem(var p:pointer;size:longint);[public,alias: 'FREEMEM'];
-var
-  h:longint;
-begin
-  h:=GlobalHandle(p);
-  if (h<>0) and (globalunlock(h)=0) and (GlobalFree(h)=0) then
-   begin
-     p:=nil;
-     exit;
-   end;
-  p:=nil;
-  memerror(size);
-end;
-
-
-function memmax(_maxavail:boolean):longint;
-const
-  status:record
-   dwLength,
-   dwMemoryLoad,
-   dwTotalPhys,
-   dwAvailPhys,
-   dwTotalPageFile,
-   dwAvailPageFile,
-   dwTotalVirtual,
-   dwAvailVirtual:longint;
-  end=(dwLength:32);
-begin
-  GlobalMemoryStatus(@status);
-  if _maxavail then
-   memmax:=status.dwAvailPageFile
-  else
-   memmax:=status.dwAvailVirtual;
-end;
-
-
-function memavail:longint;
-begin
-  memavail:=memmax(false);
-end;
-
-
-function maxavail:longint;
-begin
-  maxavail:=memmax(true);
-end;
-
-
-function HeapSize:longint;
-begin
-  HeapSize:=memmax(true);
-end;
-
-
-function growheap(size:longint):integer;
-begin
-  growheap:=0;
-end;
-
-{
-  $Log$
-  Revision 1.4  1998-07-01 15:30:03  peter
-    * better readln/writeln
-
-  Revision 1.3  1998/06/10 10:39:19  peter
-    * working w32 rtl
-
-}
-