Category : Pascal Source Code
Archive   : TSRSRC33.ZIP
Filename : XMS.PAS
* XMS - unit of XMS functions *
* Copyright (c) 1991 Kim Kokkonen, TurboPower Software. *
* May be freely distributed and used but not sold except by permission. *
* *
* Version 3.0 9/24/91 *
* first release *
* Version 3.1 11/4/91 *
* no change *
* Version 3.2 11/22/91 *
* add AllocateUmbMem, FreeUmbMem functions *
* Version 3.3 1/8/92 *
* no change *
***************************************************************************}
{$R-,S-,I-,V-,B-,F-,A-,E-,N-,G-,X-}
unit Xms;
{-XMS functions needed for TSR Utilities}
interface
const
ExhaustiveXms : Boolean = False;
type
XmsHandleRecord =
record
Handle : Word;
NumPages : Word;
end;
XmsHandles = array[1..16380] of XmsHandleRecord;
XmsHandlesPtr = ^XmsHandles;
function XmsInstalled : Boolean;
{-Returns True if XMS memory manager installed}
function QueryFreeExtMem(var TotalFree, LargestBlock : Word) : Byte;
{-Return info about free XMS (in k bytes)}
function GetHandleInfo(XmsHandle : Word;
var LockCount : Byte;
var HandlesLeft : Byte;
var BlockSizeInK : Word) : Byte;
{-Return info about specified Xms handle}
function AllocateExtMem(SizeInK : Word; var XmsHandle : Word) : Byte;
{-Allocate XMS memory}
function FreeExtMem(XmsHandle : Word) : Byte;
{-Free XMS memory}
function AllocateUmbMem(SizeInP : Word; var Segment, Size : Word) : Byte;
{-Allocate UMB memory}
function FreeUmbMem(Segment : Word) : Byte;
{-Deallocate UMB memory}
function GetXmsHandles(var XmsPages : XmsHandlesPtr) : Word;
{-Return number of XMS handles allocated, and pointer to array of handle records}
function ExtMemPossible : Boolean;
{-Return true if raw extended memory is possible}
function ExtMemTotalPrim : LongInt;
{-Returns total number of bytes of extended memory in the system}
{=======================================================================}
implementation
var
XmsControl : Pointer; {ptr to XMS control procedure}
function XmsInstalled : Boolean;
{-Returns True if XMS memory manager installed}
begin
XmsInstalled := (XmsControl <> nil);
end;
function XmsInstalledPrim : Boolean; assembler;
{-Returns True if an XMS memory manager is installed}
asm
mov ah,$30
int $21
cmp al,3
jae @Check2F
mov al,0
jmp @Done
@Check2F:
mov ax,$4300
int $2F
cmp al,$80
mov al,0
jne @Done
inc al
@Done:
end;
function XmsControlAddr : Pointer; assembler;
{-Return address of XMS control function}
asm
mov ax,$4310
int $2F
mov ax,bx
mov dx,es
end;
function QueryFreeExtMem(var TotalFree, LargestBlock : Word) : Byte; assembler;
{-Return info about free XMS}
asm
mov ah,$08
call dword ptr [XmsControl]
or ax,ax
jz @Done
les di,TotalFree
mov es:[di],dx
les di,LargestBlock
mov es:[di],ax
xor bl,bl
@Done:
mov al,bl
end;
function GetHandleInfo(XmsHandle : Word;
var LockCount : Byte;
var HandlesLeft : Byte;
var BlockSizeInK : Word) : Byte; assembler;
{-Return info about specified Xms handle}
asm
mov ah,$0E
mov dx,XmsHandle
call dword ptr [XmsControl]
test ax,1
jz @Done
les di,LockCount
mov byte ptr es:[di],bh
les di,HandlesLeft
mov byte ptr es:[di],bl
les di,BlockSizeInK
mov es:[di],dx
xor bl,bl
@Done:
mov al,bl
end;
function AllocateExtMem(SizeInK : Word; var XmsHandle : Word) : Byte; assembler;
{-Allocate XMS memory}
asm
mov ah,$09
mov dx,SizeInK
call dword ptr [XmsControl]
test ax,1
jz @Done
les di,XmsHandle
mov es:[di],dx
xor bl,bl
@Done:
mov al,bl
end;
function FreeExtMem(XmsHandle : Word) : Byte; assembler;
{-Free XMS memory}
asm
mov ah,$0A
mov dx,XmsHandle
call dword ptr [XmsControl]
test ax,1
jz @Done
xor bl,bl
@Done:
mov al,bl
end;
function AllocateUmbMem(SizeInP : Word; var Segment, Size : Word) : Byte; assembler;
asm
mov ah,$10
mov dx,SizeInP
call dword ptr [XmsControl]
les di,Size
mov es:[di],dx {return size of allocated block or largest block}
test ax,1
jz @Done
les di,Segment
mov es:[di],bx {return segment}
xor bl,bl {no error}
@Done:
mov al,bl {return error result}
end;
function FreeUmbMem(Segment : Word) : Byte; assembler;
asm
mov ah,$11
mov dx,Segment
call dword ptr [XmsControl]
test ax,1
jz @Done
xor bl,bl
@Done:
mov al,bl
end;
function GetXmsHandles(var XmsPages : XmsHandlesPtr) : Word;
{-Return number of XMS handles allocated, and pointer to array of handle records}
var
H : Word;
H0 : Word;
H1 : Word;
HCnt : Word;
FMem : Word;
FMax : Word;
HMem : Word;
LockCount : Byte;
HandlesLeft : Byte;
Delta : Integer;
Status : Byte;
Done : Boolean;
procedure ExhaustiveSearchHandles(var Handles : Word; XmsPages : XmsHandlesPtr);
{-Search handles exhaustively}
var
H : Word;
HCnt : Word;
begin
HCnt := 0;
for H := 0 to 65535 do
if GetHandleInfo(H, LockCount, HandlesLeft, HMem) = 0 then begin
inc(HCnt);
if XmsPages <> nil then
with XmsPages^[HCnt] do begin
Handle := H;
NumPages := HMem;
end;
end;
Handles := HCnt;
end;
begin
GetXmsHandles := 0;
Status := QueryFreeExtMem(FMem, FMax);
if Status = $A0 then begin
FMem := 0;
FMax := 0;
end else if Status <> 0 then
Exit;
if ExhaustiveXms then begin
{Search all 64K XMS handles for valid ones}
HCnt := 0;
ExhaustiveSearchHandles(HCnt, nil);
if HCnt <> 0 then begin
GetMem(XmsPages, HCnt*SizeOf(XmsHandleRecord));
ExhaustiveSearchHandles(HCnt, XmsPages);
GetXmsHandles := HCnt;
end;
end else begin
{Heuristic algorithm to find used handles quickly}
{Allocate two dummy handles}
if FMem > 1 then
HMem := 1
else
HMem := 0;
Status := AllocateExtMem(HMem, H0);
if Status <> 0 then
Exit;
Status := AllocateExtMem(HMem, H1);
if Status <> 0 then begin
{Deallocate dummy handle}
Status := FreeExtMem(H0);
Exit;
end;
Delta := H1-H0;
{Deallocate one dummy}
Status := FreeExtMem(H1);
{Trace back through valid handles, counting them}
HCnt := 0;
H1 := H0;
repeat
Status := GetHandleInfo(H1, LockCount, HandlesLeft, HMem);
Done := (Status <> 0);
if not Done then begin
dec(H1, Delta);
inc(HCnt);
end;
until Done;
if HCnt > 1 then begin
dec(HCnt);
GetMem(XmsPages, HCnt*SizeOf(Word));
{Go forward again through valid handles, saving them}
inc(H1, Delta);
H := 0;
while H1 <> H0 do begin
Status := GetHandleInfo(H1, LockCount, HandlesLeft, HMem);
if Status = 0 then begin
inc(H);
with XmsPages^[H] do begin
Handle := H1;
NumPages := HMem;
end;
end;
inc(H1, Delta);
end;
GetXmsHandles := HCnt;
end;
{Deallocate dummy handle}
Status := FreeExtMem(H0);
end;
end;
function DosVersion : Byte; Assembler;
{-Return major DOS version number}
asm
mov ah,$30
int $21
end;
function ExtMemPossible : Boolean;
{-Return true if raw extended memory is possible}
const
ATclass = $FC; {machine ID bytes}
Model80 = $F8;
var
MachineId : Byte absolute $FFFF : $000E;
begin
{don't allow allocation if running PC or XT, or under DOS 2.x or OS/2}
ExtMemPossible := False;
case DosVersion of
3..5 :
case MachineId of
ATclass, Model80 : ExtMemPossible := True;
end;
end;
end;
function ExtMemTotalPrim : LongInt; assembler;
{-Returns total number of bytes of extended memory in the system}
asm
mov ah,$88
int $15
mov cx,1024
mul cx
end;
begin
if XmsInstalledPrim then
XmsControl := XmsControlAddr
else
XmsControl := nil;
end.
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
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/