
{
     Oil Management Services Limited

     Turbo Pascal Standard Library

     XMS.PAS - eXtended Memory Support

     Part Number : 20-0013

     Version : 1.00

     Date : 24th July 1989
}

UNIT XMS ;

{
     Export Declarations & Definitions Section
}

INTERFACE

{
     The purpose of this Unit is to implement an interface between a Turbo
     Pascal program and an XMS driver. It implements those functions defined
     in the Extended Memory Specification (XMS) Version 2.00 for MS-DOS.

     XMS allows DOS programs to utilise additional memory found in Intel's
     80286 and 80386 based machines in a consistent, machine independent
     manner. With some restrictions, XMS adds almost 64K to the 640K which
     DOS programs can access directly. Depending on avaliable hardware, XMS
     may provide even more memory to DOS programs. XMS also provides DOS
     programs with a standard method of storing data in extended memory.
}


{
     Constants for XMSStatus Return Values
}

CONST

     XMSStatus_OperationSuccessful      = $00 ;
     XMSStatus_FunctionNotImplemented   = $80 ;
     XMSStatus_VDISKDetected            = $81 ;
     XMSStatus_A20Error                 = $82 ;
     XMSStatus_GeneralDriverError       = $8e ;
     XMSStatus_UnRecoverableDriverError = $8f ;
     XMSStatus_HMADoesNotExist          = $90 ;
     XMSStatus_HMAInUse                 = $91 ;
     XMSStatus_LessThanHMAMIN           = $92 ;
     XMSStatus_HMANotAllocated          = $93 ;
     XMSStatus_A20StillEnabled          = $94 ;
     XMSStatus_AllEMAllocated           = $a0 ;
     XMSStatus_AllEMHandlesInUse        = $a1 ;
     XMSStatus_HandleInvalid            = $a2 ;
     XMSStatus_SourceHandleInvalid      = $a3 ;
     XMSStatus_SourceOffsetInvalid      = $a4 ;
     XMSStatus_DestHandleInvalid        = $a5 ;
     XMSStatus_DestOffsetInvalid        = $a6 ;
     XMSStatus_LengthInvalid            = $a7 ;
     XMSStatus_MoveInvalidOverlap       = $a8 ;
     XMSStatus_ParityError              = $a9 ;
     XMSStatus_BlockNotLocked           = $aa ;
     XMSStatus_BlockLocked              = $ab ;
     XMSStatus_BlockLockCountOverflow   = $ac ;
     XMSStatus_LockFails                = $ad ;
     XMSStatus_SmallerUMBAvailiable     = $b0 ;
     XMSStatus_NoUMBsAvaliable          = $b1 ;
     XMSStatus_UMBSegmentNumberInvalid  = $b2 ;

VAR

     XMSStatus : BYTE     ;

{
     XMS Driver Information Constants
}

CONST

     XMSInstalled                    : BOOLEAN  = FALSE ;
     XMSVersionNumber                : EXTENDED = 0.0   ;
     XMSDriverInternalRevisionNumber : EXTENDED = 0.0   ;
     XMSHMAExists                    : BOOLEAN  = FALSE ;

{
     HMA Management Routines
}

PROCEDURE XMSRequestHMA       ;
PROCEDURE XMSReleaseHMA       ;

{
     A20 Management Routines
}

PROCEDURE XMSGlobalEnableA20  ;
PROCEDURE XMSGlobalDisableA20 ;
PROCEDURE XMSLocalEnableA20   ;
PROCEDURE XMSLocalDisableA20  ;
FUNCTION XMSQueryA20:BOOLEAN  ;

{
     Extended Memory Management Routines
}

FUNCTION XMSLargestFreeEMB:WORD ;
FUNCTION XMSTotalFreeEM:WORD ;
FUNCTION XMSAllocEMB(Amount:WORD):WORD ;
PROCEDURE XMSFreeEMB(Handle:WORD) ;

PROCEDURE XMSMoveMemtoEMB(Handle1:WORD;Ptr1:POINTER;Length:LONGINT) ;

PROCEDURE __XMSMoveMemtoEMB(Handle1:WORD;Ptr1:POINTER;Offset2:LONGINT;Length:LONGINT) ;
PROCEDURE XMSMoveMemtoMem(Ptr1,Ptr2:POINTER;Length:LONGINT) ;
PROCEDURE XMSMoveEMBtoMem(Handle1:WORD;Ptr1:POINTER;Length:LONGINT) ;
PROCEDURE __XMSMoveEMBtoMem(Handle1:WORD;Offset1:LONGINT;Ptr2:POINTER;Length:LONGINT) ;
PROCEDURE XMSMoveEMBtoEMB(Handle1,Handle2:WORD;Length:LONGINT) ;
FUNCTION XMSLockEMB(Handle:WORD):POINTER ;
PROCEDURE XMSUnLockEMB(Handle:WORD) ;
FUNCTION XMSGetEMBLockCount(Handle:WORD):BYTE ;
FUNCTION XMSGetFreeEMBHandles(Handle:WORD):BYTE ;
FUNCTION XMSGetEMBLength(Handle:WORD):WORD ;
PROCEDURE XMSReAllocEMB(Handle,NewSize:WORD) ;

{
     Upper Memory Management Routines
}

FUNCTION XMSRequestUMB(VAR Amount:WORD):WORD ; { *** DO NOT USE YET --> BUGGY *** }
PROCEDURE XMSReleaseUMB(SegmentNumber:WORD) ;

{
     Miscellaneous
}

FUNCTION HexStr(dd:BYTE):STRING ;

{
     Implementation Section
}

VAR

{
     *** DO NOT MODIFY THIS IT REALLY SHOULD NOT BE EXPORTED ***
}

     XMSControl : POINTER ;

IMPLEMENTATION
{$f-}
FUNCTION _XMSInstalled:BYTE                        ; EXTERNAL ;
FUNCTION _XMSVersionNumber:WORD                    ; EXTERNAL ;
FUNCTION _XMSDriverInternalRevisionNumber:WORD     ; EXTERNAL ;
FUNCTION _XMSHMAExists:BYTE                        ; EXTERNAL ;
PROCEDURE XMSRequestHMA                            ; EXTERNAL ;
PROCEDURE XMSReleaseHMA                            ; EXTERNAL ;
PROCEDURE XMSGlobalEnableA20                       ; EXTERNAL ;
PROCEDURE XMSGlobalDisableA20                      ; EXTERNAL ;
PROCEDURE XMSLocalEnableA20                        ; EXTERNAL ;
PROCEDURE XMSLocalDisableA20                       ; EXTERNAL ;
FUNCTION _XMSQueryA20:WORD                         ; EXTERNAL ;
FUNCTION XMSLargestFreeEMB:WORD                    ; EXTERNAL ;
FUNCTION XMSTotalFreeEM:WORD                       ; EXTERNAL ;
FUNCTION XMSAllocEMB(Amount:WORD):WORD             ; EXTERNAL ;
PROCEDURE XMSFreeEMB(Handle:WORD)                  ; EXTERNAL ;
PROCEDURE _XMSMoveEMB(ExtMemMoveStructPtr:POINTER) ; EXTERNAL ;
FUNCTION XMSLockEMB(Handle:WORD):POINTER           ; EXTERNAL ;
PROCEDURE XMSUnLockEMB(Handle:WORD)                ; EXTERNAL ;
FUNCTION XMSGetEMBLockCount(Handle:WORD):BYTE      ; EXTERNAL ;
FUNCTION XMSGetFreeEMBHandles(Handle:WORD):BYTE    ; EXTERNAL ;
FUNCTION XMSGetEMBLength(Handle:WORD):WORD         ; EXTERNAL ;
PROCEDURE XMSReAllocEMB(Handle,NewSize:WORD)       ; EXTERNAL ;
FUNCTION XMSRequestUMB(VAR Amount:WORD):WORD       ; EXTERNAL ;
PROCEDURE XMSReleaseUMB(SegmentNumber:WORD)        ; EXTERNAL ;
{$f+}
PROCEDURE _XMSNotInitialised                       ; EXTERNAL ;
{$f-}
{$L XMS.OBJ}

{
     This Function Converts BCD Numbers to Extended Type Reals
}

FUNCTION BCDtoExtended(BCD:WORD):EXTENDED ;

{
     Declarations & Definitions
}

VAR

     Digit : WORD     ;
     dd    : EXTENDED ;

{
     MAIN - Statement Part of BCDtoExtended
}

BEGIN
     dd := 0.0 ;
     Digit := (BCD AND $f000) SHR 12 ; dd := dd + Digit * 1.0e+1 ;
     Digit := (BCD AND $0f00) SHR 08 ; dd := dd + Digit * 1.0e+0 ;
     Digit := (BCD AND $00f0) SHR 04 ; dd := dd + Digit * 1.0e-1 ;
     Digit := (BCD AND $000f) SHR 00 ; dd := dd + Digit * 1.0e-2 ;
     BCDtoExtended := dd ;
END ;

{
     This Function checks to see if the A20 line is physically enabled.
     It does this in a hardware independent manner by seeing if
     "memory wrap" occurs
}

FUNCTION XMSQueryA20:BOOLEAN ;
BEGIN
     XMSQueryA20 := _XMSQueryA20 = $0001 ;
END ;

{
     Extended Memory Move Structure Definition
}

VAR

     ExtMemMoveStruct : RECORD
                              Length       : LONGINT ;
                              SourceHandle : WORD    ;
                              SourceOffset : POINTER ;
                              DestHandle   : WORD    ;
                              DestOffset   : POINTER ;
                        END ;

{
     These procedures attempt to transfer a block of data from one
     location to another. They are primarily intended for moving blocks
     of data between conventional memory and extended memory, however
     they can be used for moving blocks within conventional memory and
     within extended memory.
}

PROCEDURE XMSMoveMemToMem ;
BEGIN
     ExtMemMoveStruct.Length := Length ;
     ExtMemMoveStruct.SourceHandle := $0000 ;
     ExtMemMoveStruct.SourceOffset := Ptr1  ;
     ExtMemMoveStruct.DestHandle   := $0000 ;
     ExtMemMoveStruct.DestOffset   := Ptr2  ;
     _XMSMoveEMB(@ExtMemMoveStruct) ;
END ;

PROCEDURE XMSMoveMemToEMB ;
BEGIN
     ExtMemMoveStruct.Length := Length ;
     ExtMemMoveStruct.SourceHandle := $0000   ;
     ExtMemMoveStruct.SourceOffset := Ptr1    ;
     ExtMemMoveStruct.DestHandle   := Handle1 ;
     ExtMemMoveStruct.DestOffset   := NIL     ;
     _XMSMoveEMB(@ExtMemMoveStruct) ;
END ;

PROCEDURE __XMSMoveMemToEMB ;
BEGIN
     ExtMemMoveStruct.Length := Length ;
     ExtMemMoveStruct.SourceHandle := $0000   ;
     ExtMemMoveStruct.SourceOffset := Ptr1    ;
     ExtMemMoveStruct.DestHandle   := Handle1 ;
     ExtMemMoveStruct.DestOffset   := POINTER(Offset2) ;
     _XMSMoveEMB(@ExtMemMoveStruct) ;
END ;

PROCEDURE XMSMoveEMBToMem ;
BEGIN
     ExtMemMoveStruct.Length := Length ;
     ExtMemMoveStruct.SourceHandle := Handle1 ;
     ExtMemMoveStruct.SourceOffset := NIL     ;
     ExtMemMoveStruct.DestHandle   := $0000   ;
     ExtMemMoveStruct.DestOffset    := Ptr1   ;
     _XMSMoveEMB(@ExtMemMoveStruct) ;
END ;

PROCEDURE __XMSMoveEMBToMem ;
BEGIN
     ExtMemMoveStruct.Length := Length ;
     ExtMemMoveStruct.SourceHandle := Handle1 ;
     ExtMemMoveStruct.SourceOffset := POINTER(Offset1) ;
     ExtMemMoveStruct.DestHandle   := $0000   ;
     ExtMemMoveStruct.DestOffset    := Ptr2   ;
     _XMSMoveEMB(@ExtMemMoveStruct) ;
END ;

PROCEDURE XMSMoveEMBToEMB ;
BEGIN
     ExtMemMoveStruct.Length := Length ;
     ExtMemMoveStruct.SourceHandle := Handle1 ;
     ExtMemMoveStruct.SourceOffset := NIL     ;
     ExtMemMoveStruct.DestHandle   := Handle2 ;
     ExtMemMoveStruct.DestOffset   := NIL     ;
     _XMSMoveEMB(@ExtMemMoveStruct) ;
END ;

{
     This Function Converts a Byte to a Hex String
}

FUNCTION HexStr ;

{
     Declarations & Definitions
}

CONST

     HexDigits : ARRAY[$0..$f] OF CHAR = ('0','1','2','3','4','5','6','7','8','9','a','b','c','d','e','f') ;

{
     MAIN - Statement Part of HexStr
}

BEGIN
     HexStr := HexDigits[dd AND $f0 shr 4] + HexDigits[dd AND $0f] ;
END ;

{
     MAIN - Start Up Code for XMS.PAS
}

BEGIN

{
     Install Default XMS Control Function
}

     XMSControl := @_XMSNotInitialised ;

{
     Check XMS Driver is Installed & Try to Install XMS Control Function
}

     XMSInstalled := _XMSInstalled = $80 ;

{
     Set-Up Exported Variables
}

     IF (XMSInstalled) THEN BEGIN
         XMSVersionNumber := BCDtoExtended(_XMSVersionNumber) ;
         XMSDriverInternalRevisionNumber := BCDtoExtended(_XMSDriverInternalRevisionNumber) ;
         XMSHMAExists := _XMSHMAExists = $0001 ;
     END ;

END.

