unit heapchk;

interface
procedure WriteHexWord(w: Word);
procedure HeapStats;
function HeapFunc (Size: Word): Integer; far;

procedure HeapShow;

implementation
uses crt,saveload;
procedure WriteHexWord(w: Word);
const
 hexChars: array [0..$F] of Char =
   '0123456789ABCDEF';
begin
 Write(hexChars[Hi(w) shr 4],
       hexChars[Hi(w) and $F],
       hexChars[Lo(w) shr 4],
       hexChars[Lo(w) and $F]);
end;
procedure HeapStats;
var heaptotal: LongInt;
begin
     write('heap: HeapEnd(');
     WriteHexWord(SEG(HeapEnd^));
     Write(':');
     WriteHexWord(OFS(HeapEnd^));
     Write(') HeapOrg(');
     WriteHexWord(SEG(HeapOrg^));
     Write(':');
     WriteHexWord(OFS(HeapOrg^));
     Write(') HeapPtr(');
     WriteHexWord(SEG(HeapPtr^));
     Write(':');
     WriteHexWord(OFS(HeapPtr^));
     WriteLn(')');
     heaptotal := SEG(HeapEnd^) - SEG(HeapOrg^);
     heaptotal := (heaptotal shl 4) + OFS(HeapEnd^) - OFS(HeapOrg^);
     WriteLn('heap: TotalSize(', heaptotal, ') MaxAvail(', MaxAvail, ') MemAvail(', MemAvail, ')');
end;
function HeapFunc (Size: Word): Integer;
begin
     if Size = 0 then begin
        HeapFunc := 0;
        exit;
     end;
     textmode(co80);
     writeln('alloc failure: size(', Size, ')');
     HeapStats;
     HeapFunc := 0;
end;
procedure HeapShow;
var s1,s2:string[11];
begin
     str(MaxAvail, s1);
     str(MemAvail, s2);
     yesnorequest('Avail:' + s2 + ' MaxAlloc:' +s1,0,31);
     {textmode(co80);
     writeln('Avail:', s2, ' MaxAlloc:', s1);}
end;
end.