[Back to MEMORY SWAG index] [Back to Main SWAG index] [Original]
{
PETER BEEFTINK
See below an XMS Unit I picked up somewhere. I must admit that I have never
been successful at using it, but maybe you have more luck.
}
Unit MegaXMS;
Interface
Var
Present : Boolean; {True if XMM driver is installed}
XMSError : Byte; {Error number. if 0 -> no error}
Function XMMPresent : Boolean;
Function XMSErrorString(Error : Byte) : String;
Function XMSMemAvail : Word;
Function XMSMaxAvail : Word;
Function GetXMMVersion : Word;
Function GetXMSVersion : Word;
Procedure MoveFromEMB(Handle : Word; Var Dest; BlockLength : LongInt);
Procedure MoveToEMB(Var Source; Handle : Word; BlockLength : LongInt);
Function EMBGetMem(Size : Word) : Word;
Procedure EMBFreeMem(Handle : Word);
Procedure EMBResize(Handle, Size : Word);
Function GetAvailEMBHandles : Byte;
Function GetEMBLock(Handle : Word) : Byte;
Function GetEMBSize(Handle : Word) : Word;
Function LockEMB(Handle : Word) : LongInt;
Procedure UnlockEMB(Handle : Word);
Function UMBGetMem(Size : Word; Var Segment : Word) : Word;
Procedure UMBFreeMem(Segment : Word);
Function GetA20Status : Boolean;
Procedure DisableLocalA20;
Procedure EnableLocalA20;
Procedure DisableGlobalA20;
Procedure EnableGlobalA20;
Procedure HMAGetMem(Size : Word);
Procedure HMAFreeMem;
Function GetHMA : Boolean;
Implementation
Uses
Dos;
Const
High = 1;
Low = 2;
NumberOfErrors = 27;
ErrorNumber : Array [1..NumberOfErrors] Of Byte =
($80,$81,$82,$8E,$8F,$90,$91,$92,$93,$94,$A0,$A1,$A2,$A3,
$A4,$A5,$A6,$A7,$A8,$A9,$AA,$AB,$AC,$AD,$B0,$B1,$B2);
ErrorString : Array [0..NumberOfErrors] Of String = (
'Unknown error',
'Function no implemented',
'VDISK device driver was detected',
'A20 error occured',
'General driver errror',
'Unrecoverable driver error',
'High memory area does not exist',
'High memory area is already in use',
'DX is less than the ninimum of KB that Program may use',
'High memory area not allocated',
'A20 line still enabled',
'All extended memory is allocated',
'Extended memory handles exhausted',
'Invalid handle',
'Invalid source handle',
'Invalid source offset',
'Invalid destination handle',
'Invalid destination offset',
'Invalid length',
'Invalid overlap in move request',
'Parity error detected',
'Block is not locked',
'Block is locked',
'Lock count overflowed',
'Lock failed',
'Smaller UMB is available',
'No UMBs are available',
'Inavlid UMB segment number');
Type
XMSParamBlock= Record
Length : LongInt;
SHandle : Word;
SOffset : Array [High..Low] Of Word;
DHandle : Word;
DOffset : Array [High..Low] Of Word;
end;
Var
XMSAddr : Array [High..Low] Of Word; {XMM driver address 1=Low,2=High}
Function XMMPresent: Boolean;
Var
Regs : Registers;
begin
Regs.AX := $4300;
Intr($2F, Regs);
XMMPresent := Regs.AL = $80;
end;
Function XMSErrorString(Error : Byte) : String;
Var
I, Index : Byte;
begin
Index := 0;
For I := 1 To NumberOfErrors Do
if ErrorNumber[I] = Error Then
Index := I;
XMSErrorString := ErrorString[Index];
end;
Function XMSMemAvail : Word;
Var
Memory : Word;
begin
XMSError := 0;
if Not(Present) Then
Exit;
Asm
Mov AH, 8
Call [XMSAddr]
Or AX, AX
Jne @@1
Mov XMSError, BL
Jmp @@2
@@1:
Mov Memory, DX
@@2:
end;
XMSMemAvail := Memory;
end;
Function XMSMaxAvail : Word;
Var
Temp : Word;
begin
XMSError := 0;
if Not(Present) Then
Exit;
Asm
Mov AH, 8
Call [XMSAddr]
Or AX, AX
Jne @@1
Mov XMSError, BL
Jmp @@2
@@1:
Mov Temp, AX
@@2:
end;
XMSMaxAvail := Temp;
end;
Function EMBGetMem(Size : Word) : Word;
Var
Temp : Word;
begin
XMSError := 0;
if Not(Present) Then
Exit;
Asm
Mov AH, 9
Mov DX, Size
Call [XMSAddr]
Or AX, AX
Jne @@1
Mov XMSError, BL
Jmp @@2
@@1:
Mov Temp, DX
@@2:
end;
EMBGetMem := Temp;
end;
Procedure EMBFreeMem(Handle : Word);
begin
XMSError := 0;
if Not(Present) Then
Exit;
Asm
Mov AH, 0Ah
Mov DX, Handle
Call [XMSAddr]
Or AX, AX
Jne @@1
Mov XMSError, BL
@@1:
end;
end;
Procedure EMBResize(Handle, Size : Word);
begin
XMSError := 0;
if Not(Present) Then
Exit;
Asm
Mov AH, 0Fh
Mov DX, Handle
Mov BX, Size
Call [XMSAddr]
Or AX, AX
Jne @@1
Mov XMSError, BL
@@1:
end;
end;
Procedure MoveToEMB(Var Source; Handle : Word; BlockLength : LongInt);
Var
ParamBlock : XMSParamBlock;
XSeg, PSeg,
POfs : Word;
begin
XMSError := 0;
if Not(Present) Then
Exit;
With ParamBlock Do
begin
Length := BlockLength;
SHandle := 0;
SOffset[High] := Ofs(Source);
SOffset[Low] := Seg(Source);
DHandle := Handle;
DOffset[High] := 0;
DOffset[Low] := 0;
end;
PSeg := Seg(ParamBlock);
POfs := Ofs(ParamBlock);
XSeg := Seg(XMSAddr);
Asm
Push DS
Mov AH, 0Bh
Mov SI, POfs
Mov BX, XSeg
Mov ES, BX
Mov BX, PSeg
Mov DS, BX
Call [ES:XMSAddr]
Or AX, AX
Jne @@1
Mov XMSError, BL
@@1:
Pop DS
end;
end;
Procedure MoveFromEMB(Handle : Word; Var Dest; BlockLength : LongInt);
Var
ParamBlock : XMSParamBlock;
XSeg, PSeg,
POfs : Word;
begin
XMSError := 0;
if Not(Present) Then
Exit;
With ParamBlock Do
begin
Length := BlockLength;
SHandle := Handle;
SOffset[High] := 0;
SOffset[Low] := 0;
DHandle := 0;
DOffset[High] := Ofs(Dest);
DOffset[Low] := Seg(Dest);
end;
PSeg := Seg(ParamBlock);
POfs := Ofs(ParamBlock);
XSeg := Seg(XMSAddr);
Asm
Push DS
Mov AH, 0Bh
Mov SI, POfs
Mov BX, XSeg;
Mov ES, BX
Mov BX, PSeg
Mov DS, BX
Call [ES:XMSAddr]
Or AX, AX
Jne @@1
Mov XMSError, BL
@@1:
Pop DS
end;
end;
Function GetXMSVersion : Word;
Var
HighB, LowB : Byte;
begin
XMSError := 0;
if Not(Present) Then
Exit;
Asm
Mov AH, 0
Call [XMSAddr]
Or AX, AX
Jne @@1
Mov XMSError, BL
Jmp @@2
@@1:
Mov HighB, AH
Mov LowB, AL
@@2:
end;
GetXMSVersion := (HighB * 100) + LowB;
end;
Function GetXMMVersion : Word;
Var
HighB, LowB : Byte;
begin
XMSError := 0;
if Not(Present) Then
Exit;
Asm
Mov AH, 0
Call [XMSAddr]
Or AX, AX
Jne @@1
Mov XMSError, BL
Jmp @@2
@@1:
Mov HighB, BH
Mov LowB, BL
@@2:
end;
GetXMMVersion := (HighB * 100) + LowB;
end;
Function GetHMA : Boolean;
Var
Temp : Boolean;
begin
XMSError := 0;
if Not(Present) Then
Exit;
Temp := False;
Asm
Mov AH, 0
Call [XMSAddr]
Or AX, AX
Jne @@1
Mov XMSError, BL
Jmp @@2
@@1:
Cmp DX, 0
Je @@2
Mov Temp, 1
@@2:
end;
GetHMA := Temp;
end;
Procedure HMAGetMem(Size : Word);
begin
XMSError := 0;
if Not(Present) Then
Exit;
Asm
Mov AH, 1
Mov DX, Size
Call [XMSAddr]
Or AX, AX
Jne @@1
Mov XMSError, BL
@@1:
end;
end;
Procedure HMAFreeMem;
begin
XMSError := 0;
if Not(Present) Then
Exit;
Asm
Mov AH, 2
Call [XMSAddr]
Or AX, AX
Jne @@1
Mov XMSError, BL
@@1:
end;
end;
Procedure EnableGlobalA20;
begin
XMSError := 0;
if Not(Present) Then
Exit;
Asm
Mov AH, 3
Call [XMSAddr]
Or AX, AX
Jne @@1
Mov XMSError, BL
@@1:
end;
end;
Procedure DisableGlobalA20;
begin
XMSError := 0;
if Not(Present) Then
Exit;
Asm
Mov AH, 4
Call [XMSAddr]
Or AX, AX
Jne @@1
Mov XMSError, BL
@@1:
end;
end;
Procedure EnableLocalA20;
begin
XMSError := 0;
if Not(Present) Then Exit;
Asm
Mov AH, 5
Call [XMSAddr]
Or AX, AX
Jne @@1
Mov XMSError, BL
@@1:
end;
end;
Procedure DisableLocalA20;
begin
XMSError := 0;
if Not(Present) Then
Exit;
Asm
Mov AH, 6
Call [XMSAddr]
Or AX, AX
Jne @@1
Mov XMSError, BL
@@1:
end;
end;
Function GetA20Status : Boolean;
Var
Temp : Boolean;
begin
XMSError := 0;
if Not(Present) Then
Exit;
Temp := True;
Asm
Mov AH, 6
Call [XMSAddr]
Or AX, AX
Jne @@1
Mov XMSError, BL
Or AX, AX
Jne @@1
Or BL, BL
Jne @@2
Mov Temp, 0
Jmp @@1
@@2:
Mov XMSError, BL
@@1:
end;
end;
Function LockEMB(Handle : Word) : LongInt;
Var
Temp1,
Temp2 : Word;
Temp : LongInt;
begin
XMSError := 0;
if Not(Present) Then
Exit;
Asm
Mov AH, 0Ch
Mov DX, Handle
Call [XMSAddr]
Or AX, AX
Jne @@1
Mov XMSError, BL
Jmp @@2
@@1:
Mov Temp1, DX
Mov Temp2, BX
@@2:
end;
Temp := Temp1;
LockEMB := (Temp Shl 4) + Temp2;
end;
Procedure UnlockEMB(Handle : Word);
begin
XMSError := 0;
if Not(Present) Then
Exit;
Asm
Mov AH, 0Dh
Mov DX, Handle
Call [XMSAddr]
Or AX, AX
Jne @@1
Mov XMSError, BL
@@1:
end;
end;
Function GetEMBSize(Handle : Word) : Word;
Var
Temp : Word;
begin
XMSError := 0;
if Not(Present) Then
Exit;
Asm
Mov AH, 0Eh
Mov DX, Handle
Call [XMSAddr]
Or AX, AX
Jne @@1
Mov XMSError, BL
Jmp @@2
@@1:
Mov Temp, DX
@@2:
end;
GetEMBSize := Temp;
end;
Function GetEMBLock(Handle : Word) : Byte;
Var
Temp : Byte;
begin
XMSError := 0;
if Not(Present) Then
Exit;
Asm
Mov AH, 0Eh
Mov DX, Handle
Call [XMSAddr]
Or AX, AX
Jne @@1
Mov XMSError, BL
Jmp @@2
@@1:
Mov Temp, BH
@@2:
end;
GetEMBLock := Temp;
end;
Function GetAvailEMBHandles : Byte;
Var
Temp : Byte;
begin
XMSError := 0;
if Not(Present) Then
Exit;
Asm
Mov AH, 0Eh
Call [XMSAddr]
Or AX, AX
Jne @@1
Mov XMSError, BL
Jmp @@2
@@1:
Mov Temp, BL
@@2:
end;
GetAvailEMBHandles := Temp;
end;
Function UMBGetMem(Size : Word; Var Segment : Word) : Word; {Actual size}
Var
Temp1, Temp2 : Word;
begin
XMSError := 0;
if Not(Present) Then
Exit;
Asm
Mov AH, 10h
Mov DX, Size
Call [XMSAddr]
Or AX, AX
Jne @@1
Mov XMSError, BL
Jmp @@2
@@1:
Mov Temp2, BX
@@2:
Mov Temp1, DX
end;
Segment := Temp2;
UMBGetMem := Temp1;
end;
Procedure UMBFreeMem(Segment : Word);
begin
XMSError := 0;
if Not(Present) Then
Exit;
Asm
Mov AH, 10h
Mov DX, Segment
Call [XMSAddr]
Or AX, AX
Jne @@1
Mov XMSError, BL
@@1:
end;
end;
Var
Regs : Registers;
begin
if Not(XMMPresent) Then
begin
WriteLn('XMS not supported!');
Present := False;
Exit;
end;
Present := True;
With Regs Do
begin
AX := $4310;
Intr($2F, Regs);
XMSAddr[High] := BX;
XMSAddr[Low] := ES;
end;
end.
[Back to MEMORY SWAG index] [Back to Main SWAG index] [Original]