Power-Programmierung/CD1.mdf/magazine/pcmagazi/1992/20/umb_heap/umb_heap.pas

Pascal/Delphi Source File | 1992-05-25 | 4KB | 163 lines

UNIT UMB_Heap;
(**) INTERFACE (**)
CONST Max_Blocks = 4;
  { It's not likely more than 4 UMBs are needed }
TYPE
  UmbDataType = Array[1..Max_Blocks] of Word;

  PROCEDURE Extend_Heap;
  { Use Upper Memory Blocks to extend the heap }
  PROCEDURE GetBlockSizes(VAR US : UmbDataType);

(**) IMPLEMENTATION (**)

TYPE
{  From pg. 216 of the TP6 programmer's guide.  }
{  It's used for traversing the free blocks of  }
{  the heap.                                    }
  PFreeRec = ^TFreeRec;
  TFreeRec = RECORD
    Next : PFreeRec;
    Size : Pointer;
  END;

VAR
  Block_Segments : UmbDataType;
    { UMB starting segments }
  Block_Sizes    : UmbDataType;
    { UMB sizes             }
  SaveExitProc : Pointer;

FUNCTION UMB_Driver_Present : Boolean;
  { See if a UMB-capable driver is present. }
VAR Flag : Boolean;
BEGIN
  Flag := False;
  ASM
    mov ax,$4300
    int $2F
    cmp al,80h
    jne @Done
    inc [Flag]
  @Done:
  END;
  UMB_Driver_Present := Flag;
END;

PROCEDURE Allocate_UMB;
{ Add the four largest UMBs to the heap }
VAR
  i,
  Save_Strategy,
  Block_Segment,
  Block_Size : Word;
BEGIN
  FOR i := 1 to Max_Blocks DO
  { Assume that no blocks will be selected }
    BEGIN
      Block_Segments[i] := 0;
      Block_Sizes[i] := 0;
    END;
  ASM
    mov ax,5801h
    mov bx,0040h
    int 21h       { Set the DOS allocation strategy to }
    mov ax,5803h  { uses only high memory              }
    mov bx,0001h
    int 21h       { Set the UMB status to add UMBs }
  END;
  FOR i := 1 to Max_Blocks DO
    BEGIN
      Block_Segment := 0;
      Block_Size := 0;
      ASM
        mov ax,4800h
        mov bx,0FFFFh
        int 21h  { Get the size of the next largest UMB }
        cmp bx,0
        je @Fail
        mov ax,4800h
        int 21h              { Get the next largest UMB }
        jc @Fail
        mov [Block_Segment],ax
        mov [Block_Size],bx
      @Fail:
      END;
      { Save the UMB's size and addr }
      Block_Segments[i] := Block_Segment;
      Block_Sizes[i] := Block_Size;
    END;
END;

PROCEDURE Release_UMB; FAR;
{ Exit PROCEDURE to release UMBs }
VAR
  i,
  Segment : Word;
BEGIN
  ExitProc := SaveExitProc;
  ASM
    mov ax,5803h
    mov bx,0000h
    int 21h  { Set the UMB status to release UMBs }
  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 21h               { Release the UMB }
        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.