[Back to MEMORY SWAG index]  [Back to Main SWAG index]  [Original]

{
> Actually, there is 2 ways I know.. One way, is to extend
> the HEAP to UMBs. Another way is to extend it to EMS/XMS...

> You can't extend a TP heap like that. Maybe with DOS calls to memory
> allocation you can do that with DOS heap memory. TP actually takes 1
> large DOS heap block and does its own allocation and heap tracking within
> that for its own heap management. TP can't do what you want it to do,
> this time.

It can use UMBs or the EMS page frame; that's no problem at all.  Just allocate
them to your program using DOS services, then fiddle with the heap manager
variables so that it thinks it's got a fragmented heap.  Here's some code I
wrote a long time ago to use the EMS page frame this way; you'll need to
provide some EMS control routines yourself if you don't have the Object
Professional library.  It was written for TP 6, but should work fine in TP/BP 7
real mode, because the heap manager is the same.
}
unit EMSHeap;

{ This unit adds up to 64K of EMS memory to the Turbo Pascal heap.  Compatible
  with TP 6.0. }

{ Version 0.0.
  Copyright (1992) D.J. Murdoch.  This unit may be freely used
  provided credit is given to the author. }

interface

const
  init_alloc : boolean = true;   { Whether to allocate during initialization }
  pages      : word    = 0;      { The number of pages currently allocated   }

procedure UseEMSHeap;
{ Attempt to allocate EMS memory and attach it to the heap.  Pages will be
  set to the number of allocated pages if it succeeds. }

function ReleaseEMSHeap:boolean;
{ Attempt to release the EMS pages, and restore the heap to normal.  Will
  fail and return false if any variables are allocated in the EMS portion of
  the heap. }

implementation

uses
  opinline, opems;     { These routines from Object Professional provide
                         the EMS management routines, and the pointer
                         manipulation }

var
  handle : word;       { The handle of the allocated pages }
  SaveExitProc,
  SaveHeapEnd : Pointer; { Saved values of the System variables }

type
  PFreeRec = ^TFreeRec;
  TFreeRec = record
    Next : PFreeRec;
    Size : Pointer;
  end;

procedure UseEMSHeap;
var
  page : word;
  FreeRec : PFreeRec;  { PFreeRec is described in the Programmer's Guide }
begin
  if pages > 0 then    { Already got EMS, so exit }
    exit;
  if EMSInstalled then
  begin
    pages := EMSPagesAvail;
    if (pages <> 0) and (pages <> EMSErrorCode) then
    begin
      if pages > 4 then
        pages := 4;
      handle := AllocateEMSPages(pages);
      if handle <> EMSErrorCode then
      begin
        for page:=0 to pages-1 do
          if not MapEMSPage(handle,page,page) then { Shouldn't fail? };

        { Now we've got the pages allocated, let's set up the heap manager. }

        { First, set up a free list record at the old HeapPtr }
        FreeRec := HeapPtr;
        with FreeRec^ do
        begin
          Next := EMSPageFramePtr;
          if ofs(HeapEnd^) >= ofs(HeapPtr^) then
            Size := Ptr(seg(HeapEnd^) - Seg(HeapPtr^),
                        ofs(HeapEnd^) - Ofs(HeapPtr^))
          else
            Size := Ptr(seg(HeapEnd^) - Seg(HeapPtr^) - 1,
                        ofs(HeapEnd^) - Ofs(HeapPtr^) + 16);
        end;

        { Now adjust HeapPtr and HeapEnd }
        HeapPtr := Normalized(EMSPageFramePtr);
        SaveHeapEnd := HeapEnd;
        HeapEnd := Ptr(seg(HeapPtr^) + pages*$400,ofs(HeapPtr^));

        { Success! - so exit. }
        exit;
      end;
      { If we're here, we failed somehow. }
    end;
  end;
  pages := 0;    { Signal failure }
end;

function ReleaseEMSHeap:boolean;
{ Shrinks back to original allocation, if nothing is allocated in the EMS
  part. }
var
  FreeRec : PFreeRec;
  FreeEnd  : Pointer;
begin
  if pages > 0 then
  begin
    if PtrToLong(HeapPtr) > PtrToLong(EMSPageFramePtr) then
    begin
      ReleaseEMSHeap := false;
      exit;
    end;
    FreeRec := FreeList;
    while FreeRec^.Next <> HeapPtr do
      FreeRec := FreeRec^.Next;

    { Now FreeRec points to the last free block in regular memory }
    with FreeRec^ do
    begin
      FreeEnd := Ptr(Seg(FreeRec^) + Seg(Size^),
                        Ofs(FreeRec^) + Ofs(Size^));  { The end of the last
                                                        free block }
      if PtrToLong(FreeEnd) < PtrToLong(SaveHeapEnd) then
        HeapPtr := SaveHeapEnd        {  Memory allocated to the end of
                                         normal ram }
      else if PtrToLong(FreeEnd) = PtrToLong(SaveHeapEnd) then
        HeapPtr := FreeRec        {  A free block at the top of memory }
      else
      begin
        { This has got to be an error condition, so bail out.  }
        ReleaseEMSHeap := false;
        exit;
      end;
      HeapEnd := SaveHeapEnd;
      if not DeallocateEMSHandle(handle) then { Error we can't handle };
      pages := 0;
    end;
  end;
  ReleaseEMSHeap := true;
end;

procedure EMSExitProc; far;    { On exit, release our EMS pages }
begin
  ExitProc := SaveExitProc;
  if pages > 0 then
    if not DeallocateEMSHandle(handle) then  { Error, but nothing
                                               we can do about it };
end;

begin
  SaveExitProc := ExitProc;
  ExitProc := @EMSExitProc;
  UseEMSHeap;
end.

[Back to MEMORY SWAG index]  [Back to Main SWAG index]  [Original]