Category : Pascal Source Code
Archive   : UMB_HE.ZIP
Filename : UMB_HEAP.PAS

 
Output of file : UMB_HEAP.PAS contained in archive : UMB_HE.ZIP
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.


  3 Responses to “Category : Pascal Source Code
Archive   : UMB_HE.ZIP
Filename : UMB_HEAP.PAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/