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

    {
        Here is the UMB_Heap unit i found in a copy of PC Magazine a while back..
    This code works on my 486DX/2 66mhz with 4meg ram...    so it should (i hope)
    run on yourz too....    All you need to do to use this is just call
    Extend_Heap in your program someplace to get the extra heap memory, and
    GetBlockSizes if you wish to know how large the UMB blocks are that were
    allocated...

    }

    Unit
      UMB_Heap;

    Interface

    Const
      Max_Blocks      = 4;

    Type
      UMBDataType = Array[1..Max_Blocks] Of Word;

    Procedure Extend_Heap;
    Procedure GetBlockSizes(Var US : UMBDataType);

    Implementation

    Type
      PFreeRec        = ^TFreeRec;
      TFreeRec        = Record
        Next          : PFreeRec;
        Size          : Pointer;
      End;

    Var
      Block_Segments  : UMBDataType;
      Block_Sizes     : UMBDataType;
      SaveExitProc    : Pointer;

    Function UMB_Driver_Present : Boolean;

    Var
      Flag            : Boolean;

    Begin
      Flag := False;
      Asm
        Mov   AX, $4300
        Int   $2F
        CMP   AL, $80
        JNE   @Done
        Inc   [Flag]
      @Done:
      End;
      UMB_Driver_Present := Flag;
    End;

    Procedure Allocate_UMB;

    Var
      I,
      Save_Strategy,
      Block_Segment,
      Block_Size      : Word;

    Begin
      For I := 1 To Max_Blocks Do
        Begin
          Block_Segments[I] := 0;
          Block_Sizes[I] := 0;
        End;
      Asm
        Mov   AX, $5801
        Mov   BX, $0FFFF
        Int   $21
        Mov   AX, $5803
        Mov   BX, $0001
        Int   $21
      End;
      For I := 1 To Max_Blocks Do
        Begin
          Block_Segment := 0;
          Block_Size := 0;
          Asm
            Mov   AX, $4800
            Mov   BX, $0FFFF
            Int   $21
            CMP   BX, 0
            JE    @Fail
            Mov   AX, $4800
            Int   $21
            JC    @Fail
            Mov   [Block_Segment], AX
            Mov   [Block_Size], BX
          @Fail:
          End;
          Block_Segments[I] := Block_Segment;
          Block_Sizes[I] := Block_Size;
        End;
    End;

    Procedure Release_UMB; Far;

    Var
      I,
      Segment : Word;

    Begin
      ExitProc := SaveExitProc;
      Asm
        Mov   AX, $5803
        Mov   BX, $0000
        Int   $21
      End;
      For I := 1 To Max_Blocks Do
        Begin
          Segment := Block_Segments[I];
          If (Segment > 0) Then
            Asm
              Mov   AX, $4901
              Mov   BX, [Segment]
              Mov   ES, BX
              Int   $21
            End;
        End;
    End;

    Function Pointer_To_LongInt(p : Pointer) : LongInt;

    Type
      PtrRec          = Record
        Lo, Hi        : Word;
      End;

    Begin
      Pointer_To_LongInt := LongInt(PtrRec(P).Hi * 16 + PtrRec(P).Lo);
    End;

    Procedure Extend_Heap;

    Var
      I               : Word;
      Temp            : PFreeRec;

    Begin
      If UMB_Driver_Present then
        Begin
          Allocate_UMB;
          Temp := HeapPtr;
          I := 1;
          While ((Block_Sizes[I] > 0) And
                 (I <= Max_Blocks)) Do
            Begin
              Temp^.Next := Ptr(Block_Segments[I], 0);
              Temp       := Temp^.Next;
              Temp^.Next := HeapPtr;
              Move(Block_Sizes[I], Temp^.Size, SizeOf(Word));
              Temp^.Size := Pointer(LongInt(Temp^.Size) SHL 16);
              Inc(I);
            End;
          If (Block_Sizes[1] > 0) then
            FreeList := Ptr(Block_Segments[1], 0);
        End;
    End;

    Procedure GetBlockSizes(Var US : UMBDataType);

    Begin
      US := Block_Sizes;
    End;

    Begin
      FillChar(Block_Sizes, SizeOf(Block_Sizes), 0);
      SaveExitProc := ExitProc;
      ExitProc := @Release_UMB;
    End.

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