[Back to MEMORY SWAG index] [Back to Main SWAG index] [Original]

    Unit XMSLib;
    { XMSLIB V2.02  Copyright (c) 1994 by Andrew Eigus Fido Net: 2:5100/33 }
    { XMS Interface for Turbo Pascal version 7.0 }

    (*
      XMS termines:

      XMS: eXtended Memory Specification
      XMS gives access to extended memory and noncontiguous/nonEMS
          memory above 640K
      UMB: Upper Memory Block
      HMA: High Memory Area

      Material used:

      C and ASM source of XMS Library (c) by Michael Graff,
      eXtended Memory Specification unit source (c) by Yuval Tal,
      Interrupt List V1.02 (WindowBook) (c) 1984-90 Box Company, Inc.
    *)

    interface

    const

      { XMS function numbers }

      XGetVersion    = $00;
      XRequestHMA    = $01;
      XReleaseHMA    = $02;
      XGlobalE20     = $03;
      XGlobalD20     = $04;
      XLocalE20      = $05;
      XLocalD20      = $06;
      XQuery20       = $07;
      XGetMemSize    = $08;
      XAllocEMB      = $09;
      XFreeEMB       = $0A;
      XMoveEMB       = $0B;
      XLockEMB       = $0C;
      XUnlockEMB     = $0D;
      XGetHandleInfo = $0E;
      XReallocEMB    = $0F;
      XRequestUMB    = $10;
      XReleaseUMB    = $11;

      { XMS_GetVersion parameters }

      XMS = True;  { Get XMS version }
      XMM = False; { Get XMM version }

      { XMS functions return codes }

      xmsrOk            = $00; { Function successful }
      xmsrNotInitd      = $01; { XMS driver not initialized by XMS_Setup }
      xmsrBadFunction   = $80; { Function not implemented }
      xmsrVDiskDetected = $81; { VDisk was detected }
      xmsrA20Error      = $82; { An A20 error occurred }
      xmsrDriverError   = $8E; { A general driver error }
      xmsrUnrecError    = $8F; { Unrecoverable driver error }
      xmsrNoHMA         = $90; { HMA does not exist }
      xmsrHMAInUse      = $91; { HMA is already in use }
      xmsrHMAMinError   = $92; { HMAMIN parameter is too large }
      xmsrHMANotAlloc   = $93; { HMA is not allocated }
      xmsrA20Enabled    = $94; { A20 line still enabled }
      xmsrNoMoreMem     = $A0; { All extended memory is allocated }
      xmsrNoMoreHandles = $A1; { All available XMS handles are allocated }
      xmsrBadHandle     = $A2; { Invalid handle }
      xmsrBadSourceH    = $A3; { Source handle is invalid }
      xmsrBadSourceO    = $A4; { Source offset is invalid }
      xmsrBadDestH      = $A5; { Destination handle is invalid }
      xmsrBadDestO      = $A6; { Destination offset is invalid }
      xmsrBadLength     = $A7; { Length (size) is invalid }
      xmsrBadOverlap    = $A8; { Move has an invalid overlap }
      xmsrParityError   = $A9; { Parity error occurred }
      xmsrBlkNotLocked  = $AA; { Block is not locked }
      xmsrBlkLocked     = $AB; { Block is locked }
      xmsrBlkLCOverflow = $AC; { Block lock count overflowed }
      xmsrLockFailed    = $AD; { Lock failed }
      xmsrSmallerUMB    = $B0; { Only a smaller UMB is available }
      xmsrNoUMB         = $B1; { No UMB's are available }
      xmsrBadUMBSegment = $B2; { UMB segment number is invalid }

    type
      THandle = Word; { Memory block handle type }

    var
      XMSResult : byte; { Returns the status of the last XMS operation performed }

    function XMS_Setup : boolean;
    { This function returns True is the extended memory manager device driver
      is installed in memory and active. True if installed, False if not
      installed. You should call this function first, before any other are
      called so it will setup memory manager for use with your program }

    function XMS_GetVersion(OfWhat : boolean) : word;
    { This function returns eighter the version of the extended memory
      specifications version, or the version of the extended memory manager
      device driver version, depends on what you're using as an OfWhat
      parameter (see XMS_GetVersion parameters in const section of the unit).
      The result's low byte is the major version number, and the high byte is
      the minor version number }

    function XMS_HMAAvail : boolean;
    { This function obtains the status of the high memory area (HMA).
      If the result is true, HMA exists. If the result is False no HMA exists }

    function XMS_AllocHMA(Size : word) : byte;
    { This function allocates high memory area (HMA). Size contains the the
      bytes which are needed. The maximum HMA allocation is 65520 bytes.
      The base address of the HMA is FFFF:0010h. If an application fails
      to release the HMA before it terminates, the HMA becomes unavailable
      to the other programs until the system is restarted. Function returns
      zero (xmsrOk) if the call was successful, or one of the xmsr-error codes
      if the call has failed }

    function XMS_FreeHMA : byte;
    { This function releases the high memory area (HMA) and returns zero if
      the call was successful, or one of the xmsr-error codes if the call has
      failed }

    function XMS_GlobalEnableA20 : byte;
    { This function enables the A20 line and should only be used by programs
      that have successfully allocated the HMA. The result is zero if the
      call was successful, otherwise, the result is one of the (xmsr)
      return values }

    function XMS_GlobalDisableA20 : byte;
    { This function disables the A20 line and should only be used by programs
      that do not own the HMA. The result is zero if the call was successful,
      otherwise, the result is one of the (xmsr) return values }

    function XMS_LocalEnableA20 : byte;
    { This function enables the A20 line and should only be used by programs
      that have successfully allocated the HMA. The result is zero if the call
      was successful, otherwise, the result is one of the (xmsr) return values }

    function XMS_LocalDisableA20 : byte;
    { This function disables the A20 line and should only be used by programs
      that do not own the HMA. The A20 line should be disabled before the program
      releases control of the system. The result is zero if the call was
      successful, otherwise, the result is one of the (xmsr) return values }

    function XMS_QueryA20 : boolean;
    { This function returns the status of the A20 address line. If the result is
      True then the A20 line is enabled. If False, it is disabled }

    function XMS_MemAvail : word;
    { This function returns the total free extended memory in kilo-bytes }

    function XMS_MaxAvail : word;
    { This function returns the largest free extended memory block in kilo-bytes }

    function XMS_AllocEMB(Size : word) : THandle;
    { This function allocates extended memory block (EMB). Size defines the size
      of the requested block in kilo-bytes. Function returns a handle number
      which is used by the other EMB commands to refer to this block. If the call
      to this function was unsuccessful, zero is returned instead of the handle
      number and (xmsr) error code is stored in XMSResult variable }

    function XMS_ReallocEMB(Handle : THandle; Size : word) : byte;
    { This function reallocates EMB. Handle is a handle number which was given
      by XMS_AllocEMB. Size defines a new size of the requested block in
      kilo-bytes. Function returns zero if the call was successful, or
      a (xmsr) error code if it failed }

    function XMS_FreeEMB(Handle : THandle) : byte;
    { This function releases allocated extended memory. Handle is a handle number
      which was given by XMS_AllocEMB. Note: If a program fails to release its
      extended memory before it terminates, the memory becomes unavailable to
      other programs until the system is restarted. Blocks may not be released
      while they are locked. Function returns zero if the call was successful, or
      a (xmsr) error code if the call has failed }

    function XMS_MoveFromEMB(Handle : THandle; var Dest; Count : longint) : byte;
    { This function moves data from the extended memory to the conventional
      memory. Handle is a handle number given by XMS_AllocEMB. Dest is a non-typed
      variable so any kind of data can be written there. Count is the number of
      bytes which should be moved. The state of the A20 line is preserved.
      Function returns zero if the call was successful, or a (xmsr) error code
      if the call has failed }

    function XMS_MoveToEMB(Handle : THandle; var Source; Count : longint) : byte;
    { This function moves data from the conventional memory to the extended
      memory. Handle is a handle number given by XMS_AllocEMB. Source is a
      non-typed variable so any kind of data can be written there. Count is
      the number of bytes which should be moved. The state of the A20 line is
      preserved. Function returns zero if the call was successful, or a
      (xmsr) error code if the call has failed }

    function XMS_LockEMB(Handle : THandle) : pointer;
    { This function locks a specified EMB. This function is intended for use by
      programs which enable the A20 line and access extended memory directly.
      Handle is a handle number given by XMS_AllocEMB. The result is a 32-bit
      linear address of the locked block or NIL if lock did not succeed. The
      result value is stored in XMSResult variable }

    function XMS_UnlockEMB(Handle : THandle) : byte;
    { This function unlocks previously locked blocks (by XMS_LockEMB). After
      the EMB is unlocked the 32-bit pointer returned by XMS_LockEMB becomes
      invalid and should not be used. Handle is a handle number given by
      XMS_AllocEMB. The result value is zero if the call was successful,
      otherwise it is one of the (xmsr) return codes }

    function XMS_EMBHandlesAvail(Handle : THandle) : byte;
    { This function returns the number of free handles which are available to
      your program. Handle is a handle number given by XMS_AllocEMB. The result
      value is stored in XMSResult variable }

    function XMS_EMBLockCount(Handle : THandle) : byte;
    { This function returns the lock count of a specified EMB. Handle is a handle
      number given by XMS_AllocEMB. If the function returns zero it means that
      the block is not locked. The result value is stored in XMSResult variable }

    function XMS_EMBSize(Handle : THandle) : word;
    { This function determines the size of a specified EMB. Handle is a handle
      number given by XMS_AllocEMB. The result is the size of the block in
      kilo-bytes. The result code is stored in XMSResult variable }

    function XMS_AllocUMB(Size : word) : longint;
    { This function allocates upper memory blocks (UMBs). Size is the size of
      the block in paragraphs.
      Function returns:
        - segment base of the allocated block in the low-order word
        - actual block size in paragraphs in the high-order word
          In case of an error the high-order word will be the size of the largest
          available block in paragraphs.
      The result code is stored in XMSResult variable }

    function XMS_FreeUMB(Segment : word) : byte;
    { This function releases the memory that was allocated by XMS_FreeUMB.
      Segment must contain the segment base of the block which must be
      released. The result value is zero if the call was successful, or
      one of the (xmsr) error codes, otherwise }

    function XMS_GetErrorMsg(ErrorCode : byte) : string;
    { This function translates the error code which is returned by all the
      XMS_ functions in the unit from a number to a string. The error code is
      written to the global variable XMSResult (byte). If XMSResult is equal
      to zero then no errors were encountered. For more information about
      the result codes, see (xmsr) constants in the unit's const section }

    implementation

    type
      TransferRec = record
        TransferSize : longint;
        SourceHandle : THandle;
        SourceOffset : longint;
        DestHandle : THandle;
        DestOffset : longint
      end;

    var
      XMSInitd : boolean;
      XMSDriver : procedure;
      TR : TransferRec; { Internal transfer EMB structure }

    Function XMS_Setup; assembler;
    Asm
      MOV [XMSInitd],False
      MOV AX,4300h        { XMS Driver installation check }
      INT 2Fh
      CMP AL,80h
      JE  @@1             { XMS found }
      MOV AL,False        { else XMS manager not found }
      JMP @@2
    @@1:
      MOV AX,4310h        { Get address of XMS driver }
      INT 2Fh
      MOV WORD [XMSDriver],BX    { store offset }
      MOV WORD [XMSDriver+2],ES  { store segment }
      INC [XMSInitd]             { we have init'd our code }
      MOV AL,True
    @@2:
    End; { XMS_Setup }

    Function XMS_GetVersion; assembler;
    Asm
      MOV [XMSResult],xmsrNotInitd
      CMP [XMSInitd],True
      JNE @@1
      MOV AH,XGetVersion     { Function to get version }
      CALL [XMSDriver]       { Call the XMS driver }
      MOV [XMSResult],xmsrOk
      CMP OfWhat,XMS         { XMS or XMM version? }
      JE  @@1                { If XMS, it's already in AX }
      MOV AX,BX              { If XMM, it's in BX, so move it to AX }
    @@1:
    End; { XMS_GetVersion }

    Function XMS_HMAAvail; assembler;
    Asm
      MOV [XMSResult],xmsrNotInitd
      CMP [XMSInitd],True
      JNE @@1
      MOV AH,XGetVersion     { Function number }
      CALL [XMSDriver]
      MOV [XMSResult],xmsrOk
      MOV AL,DL              { Store result value }
    @@1:
    End; { XMS_HMAAvail }

    Function XMS_AllocHMA; assembler;
    Asm
      MOV BL,xmsrNotInitd
      CMP [XMSInitd],True
      JNE @@1
      MOV DX,Size         { Ammount of HMA wanted }
      MOV AH,XRequestHMA  { Function to allocate HMA }
      CALL [XMSDriver]    { Call the XMS driver }
      OR  AX,AX
      JZ  @@1
      XOR BL,BL           { No error }
    @@1:
      MOV AL,BL           { Store result value }
      MOV [XMSResult],BL  { Save error code }
    End; { XMS_AllocHMA }

    Function XMS_FreeHMA; assembler;
    Asm
      MOV BL,xmsrNotInitd
      CMP [XMSInitd],True
      JNE @@1
      MOV AH,XReleaseHMA  { Function to release HMA }
      CALL [XMSDriver]    { Call the XMS driver }
      OR  AX,AX
      JZ  @@1             { If error then jump, else }
      XOR BL,BL           { clear error code }
    @@1:
      MOV AL,BL
      MOV [XMSResult],BL  { Get return code in XMSResult }
    End; { XMS_FreeHMA }

    Function XMS_GlobalEnableA20; assembler;
    Asm
      MOV BL,xmsrNotInitd
      CMP [XMSInitd],True
      JNE @@1
      MOV AH,XGlobalE20   { Function code }
      CALL [XMSDriver]    { Call the XMS driver }
      OR  AX,AX
      JZ  @@1
      XOR BL,BL           { Return no error }
    @@1:
      MOV AL,BL
      MOV [XMSResult],BL  { Store result value }
    End; { XMS_GlobalEnableA20 }

    Function XMS_GlobalDisableA20; assembler;
    Asm
      MOV BL,xmsrNotInitd
      CMP [XMSInitd],True
      JNE @@1
      MOV AH,XGlobalD20   { Function code }
      CALL [XMSDriver]    { Call the XMS driver }
      OR  AX,AX
      JZ  @@1
      XOR BL,BL           { Return success }
    @@1:
      MOV AL,BL
      MOV [XMSResult],BL  { Store result value }
    End; { XMS_GlobalDisableA20 }

    Function XMS_LocalEnableA20; assembler;
    Asm
      MOV BL,xmsrNotInitd
      CMP [XMSInitd],True
      JNE @@1
      MOV AH,XLocalE20    { Function code }
      CALL [XMSDriver]    { Call the XMS driver }
      OR  AX,AX
      JZ  @@1
      XOR BL,BL           { Return no error value }
    @@1:
      MOV AL,BL
      MOV [XMSResult],BL  { Store result value }
    End; { XMS_LocalEnableA20 }

    Function XMS_LocalDisableA20; assembler;
    Asm
      MOV BL,xmsrNotInitd
      CMP [XMSInitd],True
      JNE @@1
      MOV AH,XLocalD20    { Function code }
      CALL [XMSDriver]    { Call the XMS driver }
      OR  AX,AX
      JZ  @@1
      XOR BL,BL           { Return no error }
    @@1:
      MOV AL,BL
      MOV [XMSResult],BL  { Save result }
    End; { XMS_LocalDisableA20 }

    Function XMS_QueryA20; assembler;
    Asm
      MOV BL,xmsrNotInitd
      CMP [XMSInitd],True
      JNE @@1
      MOV AH,XQuery20     { Function code }
      CALL [XMSDriver]    { Call the XMS driver; result in AL }
    @@1:
      MOV [XMSResult],BL  { Store error code value }
    End; { XMS_QueryA20 }

    Function XMS_MemAvail; assembler;
    Asm
      MOV BL,xmsrNotInitd
      CMP [XMSInitd],True
      JNE @@1
      MOV AH,XGetMemSize  { Function code }
      CALL [XMSDriver]    { Call the XMS driver }
      MOV AX,DX           { AX=Get XMS memory available in K-bytes }
    @@1:
      MOV [XMSResult],BL  { Store result value }
    End; { XMS_MemAvail }

    Function XMS_MaxAvail; assembler;
    Asm
      MOV BL,xmsrNotInitd
      CMP [XMSInitd],True
      JNE @@1
      MOV AH,XGetMemSize  { Function code }
      CALL [XMSDriver]    { Call the XMS driver }
                          { AX=Get XMS maximum memory block available in K-bytes }
    @@1:
      MOV [XMSResult],BL  { Store result value }
    End; { XMS_MaxAvail }

    Function XMS_AllocEMB; assembler;
    Asm
      MOV BL,xmsrNotInitd
      CMP [XMSInitd],True
      JNE @@2
      MOV AH,XAllocEMB    { Function code }
      MOV DX,Size         { Number of K-Bytes to allocate }
      CALL [XMSDriver]    { Call the XMS driver }
      OR  AX,AX
      JZ  @@1
      MOV AX,DX           { Store handle number in AX }
      XOR BL,BL           { Set no error }
      JMP @@2
    @@1:
      XOR AX,AX           { Return handle 0 if error }
    @@2:
      MOV [XMSResult],BL
    End; { XMS_AllocEMB }

    Function XMS_ReallocEMB; assembler;
    Asm
      MOV BL,xmsrNotInitd
      CMP [XMSInitd],True
      JNE @@1
      MOV AH,XReallocEMB  { Function code }
      MOV DX,Handle       { Handle number }
      MOV BX,Size         { New size wanted in K-Bytes }
      CALL [XMSDriver]    { Call the XMS driver }
      OR  AX,AX
      JZ  @@1
      XOR BL,BL           { There's no error }
    @@1:
      MOV AL,BL           { Return result value }
      MOV [XMSResult],BL  { Store error code }
    End; { XMS_ReallocEMB }

    Function XMS_FreeEMB; assembler;
    Asm
      MOV BL,xmsrNotInitd
      CMP [XMSInitd],True
      JNE @@1
      MOV AH,XFreeEMB     { Function code }
      MOV DX,Handle       { Set handle number in DX }
      CALL [XMSDriver]    { Call the XMS driver }
      OR  AX,AX
      JZ  @@1
      XOR BL,BL           { No error }
    @@1:
      MOV AL,BL           { Return result value }
      MOV [XMSResult],BL  { Store error code }
    End; { XMS_FreeEMB }

    Function XMS_MoveFromEMB; assembler;
    Asm
      PUSH DS
      MOV BL,xmsrNotInitd
      CMP [XMSInitd],True
      JNE @@1
      MOV CX,WORD PTR [Count]
      MOV TR.WORD PTR [TransferSize],CX
      MOV CX,WORD PTR [Count+2]
      MOV TR.WORD PTR [TransferSize+2],CX
      MOV CX,Handle
      MOV TR.SourceHandle,CX
      MOV WORD PTR [TR.SourceOffset],0
      MOV WORD PTR [TR.SourceOffset+2],0
      MOV TR.DestHandle,0
      LES SI,Dest
      MOV WORD PTR [TR.DestOffset],SI
      MOV WORD PTR [TR.DestOffset+2],ES
      MOV AH,XMoveEMB
      MOV DX,SEG TR
      MOV DS,DX
      MOV SI,OFFSET TR
      CALL [XMSDriver]
      OR  AX,AX
      JZ  @@1
      XOR BL,BL
    @@1:
      MOV AL,BL
      MOV [XMSResult],BL
      POP DS
    End; { XMS_MoveFromEMB }

    Function XMS_MoveToEMB; assembler;
    Asm
      PUSH DS
      MOV BL,xmsrNotInitd
      CMP [XMSInitd],True
      JNE @@1
      MOV CX,WORD PTR [Count]
      MOV TR.WORD PTR [TransferSize],CX
      MOV CX,WORD PTR [Count+2]
      MOV TR.WORD PTR [TransferSize+2],CX
      MOV TR.SourceHandle,0
      LES SI,Source
      MOV WORD PTR [TR.SourceOffset],SI
      MOV WORD PTR [TR.SourceOffset+2],ES
      MOV CX,Handle
      MOV TR.DestHandle,CX
      MOV WORD PTR [TR.DestOffset],0
      MOV WORD PTR [TR.DestOffset+2],0
      MOV AH,XMoveEMB
      MOV DX,SEG TR
      MOV DS,DX
      MOV SI,OFFSET TR
      CALL [XMSDriver]
      OR  AX,AX
      JZ  @@1
      XOR BL,BL
    @@1:
      MOV AL,BL
      MOV [XMSResult],BL
      POP DS
    End; { XMS_MoveToEMB }

    Function XMS_LockEMB; assembler;
    Asm
      CMP [XMSInitd],True
      JNE @@1             { if not initialized, return the NIL pointer }
      MOV AH,XLockEMB     { Function code }
      MOV DX,Handle       { Handle in DX }
      CALL [XMSDriver]    { Call the XMS driver }
      OR  AX,AX           { Was the call successful? }
      JNZ @@2             { Yep, so jump and return pointer }
    @@1:
      XOR AX,AX
      XOR DX,DX           { Return NIL }
      MOV [XMSResult],xmsrLockFailed
      JMP @@3
    @@2:
      MOV AX,BX           { Offset in AX, Segment in DX }
      MOV XMSResult,xmsrOk
    @@3:
    End; { XMS_LockEMB }

    Function XMS_UnlockEMB; assembler;
    Asm
      MOV BL,xmsrNotInitd
      CMP [XMSInitd],True
      JNE @@1
      MOV AH,XUnlockEMB   { Function code }
      MOV DX,Handle       { Handle in DX }
      CALL [XMSDriver]    { Call the XMS driver }
      OR  AX,AX
      JZ  @@1
      XOR BL,BL
    @@1:
      MOV AL,BL
      MOV [XMSResult],BL
    End; { XMS_UnlockEMB }

    Function XMS_EMBHandlesAvail; assembler;
    Asm
      MOV BL,xmsrNotInitd
      CMP [XMSInitd],True
      JNE @@1
      MOV AH,XGetHandleInfo { Function code }
      MOV DX,Handle
      CALL [XMSDriver]
      OR  AX,AX
      JZ  @@1
      MOV AL,BL             { Save number of free handles }
      XOR BL,BL
    @@1:
      MOV [XMSResult],BL
    End; { XMS_EMBHandlesAvail }

    Function XMS_EMBLockCount; assembler;
    Asm
      MOV BL,xmsrNotInitd
      CMP [XMSInitd],True
      JNE @@1
      MOV AH,XGetHandleInfo
      MOV DX,Handle         { Handle in DX }
      CALL [XMSDriver]
      OR  AX,AX
      JZ  @@1
      MOV AL,BH             { Save lock count }
      XOR BL,BL
    @@1:
      MOV [XMSResult],BL
    End; { XMS_EMBLockCount }

    Function XMS_EMBSize; assembler;
    Asm
      MOV BL,xmsrNotInitd
      CMP [XMSInitd],True
      JNE @@1
      MOV AH,XGetHandleInfo
      MOV DX,Handle
      CALL [XMSDriver]
      OR  AX,AX
      JZ  @@1
      MOV AX,DX             { Save EMB size in K-bytes }
      XOR BL,BL
    @@1:
      MOV [XMSResult],BL
    End; { XMS_EMBSize }

    Function XMS_AllocUMB; assembler;
    Asm
      MOV BL,xmsrNotInitd
      CMP [XMSInitd],True
      JNE @@1
      MOV AH,XRequestUMB  { Function code }
      MOV DX,Size         { Number of paragraphs we want }
      CALL [XMSDriver]    { Call the XMS driver }
      OR  AX,AX
      JZ  @@1
      MOV AX,BX           { Return segment of UMB in low-order word }
                          { Actual block size in high-order word }
      XOR BL,BL
    @@1:
      MOV [XMSResult],BL
    End; { XMS_AllocUMB }

    Function XMS_FreeUMB; assembler;
    Asm
      MOV BL,xmsrNotInitd
      CMP [XMSInitd],True
      JNE @@1
      MOV AH,XReleaseUMB  { Function code }
      MOV DX,Segment      { Segment of UMB to release }
      CALL [XMSDriver]    { Call the XMS driver }
      OR  AX,AX
      JZ  @@1
      XOR BL,BL
    @@1:
      MOV AL,BL
      MOV [XMSResult],BL
    End; { XMS_FreeUMB }

    Function XMS_GetErrorMsg;
    var S : ^String;
    Begin
      New(S);
      case ErrorCode of
        xmsrNotInitd:      S^ := 'XMS driver not initialized';
        xmsrBadFunction:   S^ := 'Function not implemented';
        xmsrVDiskDetected: S^ := 'VDisk has detected';
        xmsrA20Error:      S^ := 'An A20 error occurred';
        xmsrDriverError:   S^ := 'A general driver error';
        xmsrUnrecError:    S^ := 'Unrecoverable driver error';
        xmsrNoHMA:         S^ := 'HMA does not exist';
        xmsrHMAInUse:      S^ := 'HMA is already in use';
        xmsrHMAMinError:   S^ := 'HMAMIN parameter is too large';
        xmsrHMANotAlloc:   S^ := 'HMA is not allocated';
        xmsrA20Enabled:    S^ := 'A20 line still enabled';
        xmsrNoMoreMem:     S^ := 'All extended memory is allocated';
        xmsrNoMoreHandles: S^ := 'All available XMS handles are allocated';
        xmsrBadHandle:     S^ := 'Invalid block handle';
        xmsrBadSourceH:    S^ := 'Block source handle is invalid';
        xmsrBadSourceO:    S^ := 'Block source offset is invalid';
        xmsrBadDestH:      S^ := 'Block destination handle is invalid';
        xmsrBadDestO:      S^ := 'Block destination offset is invalid';
        xmsrBadLength:     S^ := 'Block length is invalid';
        xmsrBadOverlap:    S^ := 'Move operation has an invalid overlap';
        xmsrParityError:   S^ := 'Parity error';
        xmsrBlkNotLocked:  S^ := 'Block is not locked';
        xmsrBlkLocked:     S^ := 'Block is locked';
        xmsrBlkLCOverflow: S^ := 'Block lock count overflowed';
        xmsrLockFailed:    S^ := 'Lock failed';
        xmsrSmallerUMB:    S^ := 'Too large UMB requested';
        xmsrNoUMB:         S^ := 'No UMB''s are available';
        xmsrBadUMBSegment: S^ := 'UMB segment number is invalid';
        else S^ := 'Unknown error'
      end;
      XMS_GetErrorMsg := S^;
      Dispose(S)
    End; { XMS_GetErrorMsg }

    Begin
      { Initialize global variables }
      XMSInitd := False;
      XMSResult := xmsrOk
    End. { XMSLib }

    { ***** XMSDEMO.PAS ***** }

    Program XMSLibDemo;
    { Copyright (c) 1994 by Andrew Eigus              Fido Net: 2:5100/33 }
    { XMS Interface V2.02 for Turbo Pascal version 7.0 demonstration program }

    (*
      Tested on IBM 486 SX 33Mhz with 4MB RAM with the following configuration:
         1)  HIMEM.SYS  (MS-DOS 6.2 XMS memory manager)
         2)  HIMEM.SYS  (MS-DOS 6.2 XMS memory manager)
      EMM386.EXE (MS-DOS 6.2 EMS memory manager)

      If any inpredictable errors occur in your system while running this demo,
      please be so kind to inform me:

     AndRew's BBS Phone: 003-712-559777 (Riga, Latvia) 24h 2400bps
     Voice Phone:     003-712-553218
     Fido Net:     2:5100/20.12
    *)

    {X+}{$R-}

    uses XMSLib;

    type
      TMsg = array[1..14] of Char;

      TUMBAllocRec = record
        Size : word;
        SegAddr : word
      end;

    const
      Message1 : TMsg = 'First message ';
      Message2 : TMsg = 'Second message';

      YesNo : array[boolean] of string[3] = ('No', 'Yes');
      A20State : array[boolean] of string[8] = ('Disabled', 'Enabled');

    var
      Version, Memory, Handle, BlockLength : word;
      Locks, FreeHandles : byte;
      HMAAvailable : boolean;
      Address : pointer;
      UMB : longint;

    Function Hex(Num : longint; Places : byte) : string;
    const HexTab : array[0..15] of Char = '0123456789ABCDEF';
    var
      HS : string[8];
      Digit : byte;
    Begin
      HS[0] := Chr(Places);
      for Digit := Places downto 1 do
      begin
        HS[Digit] := HexTab[Num and $0000000F];
        Num := Num shr 4
      end;
      Hex := HS
    End; { Hex }

    Function Check(Result : byte; Func : string) : byte;
    Begin
      if Result <> xmsrOk then
        WriteLn(Func, ' returned ',
          Hex(Result, 2), 'h (', Result, '): ', XMS_GetErrorMsg(Result));
      Check := Result
    End; { Check }

    Procedure ShowA20State;
    var State : boolean;
    Begin
      State := XMS_QueryA20;
      if Check(XMSResult, 'XMS_QueryA20') = xmsrOk then
        WriteLn('A20 state: ', A20State[State])
    End; { ShowA20State }

    Procedure Wait4Return;
    Begin
      WriteLn;
      WriteLn('Press ENTER to continue');
      ReadLn
    end; { Wait4Return }

    Begin
      WriteLn('XMS Library V2.02 Demonstration program by Andrew Eigus'#10);
      if XMS_Setup then
      begin

        Version := XMS_GetVersion(XMS);
        if Check(XMSResult, 'XMS_GetVersion(XMS)') = xmsrOk then
          WriteLn('XMS version ', Hi(Version), '.', Lo(Version), ' present');
        Version := XMS_GetVersion(XMM);
        if Check(XMSResult, 'XMS_GetVersion(XMM)') = xmsrOk then
          WriteLn('XMM version ', Hi(Version), '.', Lo(Version), ' detected');
        HMAAvailable := XMS_HMAAvail;
        if Check(XMSResult, 'XMS_HMAAvail') = xmsrOk then
          WriteLn('HMA Available: ', YesNo[HMAAvailable]);

        WriteLn;
        Memory := XMS_MemAvail;
        if Check(XMSResult, 'XMS_MemAvail') = xmsrOk then
          WriteLn('Free XMS memory available: ', Memory, ' KB')
        else
          if XMSResult = xmsrNoMoreMem then Halt(xmsrNoMoreMem);
        Memory := XMS_MaxAvail;
        if Check(XMSResult, 'XMS_MaxAvail') = xmsrOk then
          WriteLn('Largest XMS memory block: ', Memory, ' KB');

        WriteLn;
        if HMAAvailable then
          if Check(XMS_AllocHMA($FFFF), 'XMS_AllocHMA') = xmsrOk then
          begin
            WriteLn('HMA: Block allocated');
            if Check(XMS_FreeHMA, 'XMS_FreeHMA') = xmsrOk then
              WriteLn('HMA: Block released')
          end;

        Wait4Return;

        WriteLn('XMS data transfer test'#10);
        WriteLn('Message1: ', Message1);
        WriteLn('Message2: ', Message2);

        Handle := XMS_AllocEMB(1);
        if Check(XMSResult, 'XMS_AllocEMB') = xmsrOk then
        begin
          WriteLn('1 KB EMB allocated. Handle number: ', Hex(Handle, 4), 'h');
          { Now copy our little Message1 to extended memory }
          if Check(XMS_MoveToEMB(Handle, Message1, SizeOf(TMsg)),
            'XMS_MoveToEMB') = xmsrOk then WriteLn('Transfer to XMS: OK');
          { Now copy it back to the second string }
          if Check(XMS_MoveFromEMB(Handle, Message2, SizeOf(TMsg)),
            'XMS_MoveFromEMB') = xmsrOk then WriteLn('Transfer from XMS: OK');
          WriteLn('Message1: ', Message1);
          WriteLn('Message2: ', Message2);
          WriteLn;
          if Check(XMS_ReallocEMB(Handle, 2),
            'XMS_ReallocEMB') = xmsrOk then
            WriteLn('EMB reallocated. New size: 2 KB');
          WriteLn;
          Address := XMS_LockEMB(Handle);
          if Check(XMSResult, 'XMS_LockEMB') = xmsrOk then
            WriteLn('EMB locked at linear memory address ',
              Hex(Longint(Address), 8), 'h');

          WriteLn;
          FreeHandles := XMS_EMBHandlesAvail(Handle);
          if Check(XMSResult, 'XMS_EMBHandlesAvail') = xmsrOk then
            WriteLn('EMB Handles available: ', FreeHandles);
          Locks := XMS_EMBLockCount(Handle);
          if Check(XMSResult, 'XMS_EMBLockCount') = xmsrOk then
            WriteLn('EMB Lock count: ', Locks);
          BlockLength := XMS_EMBSize(Handle);
          if Check(XMSResult, 'XMS_EMBSize') = xmsrOk then
            WriteLn('EMB Length: ', BlockLength, ' KB');

          WriteLn;
          if Check(XMS_UnlockEMB(Handle), 'XMS_UnlockEMB') = xmsrOk then
              WriteLn('EMB unlocked');

          WriteLn;
          if Check(XMS_FreeEMB(Handle), 'XMS_FreeEMB') = xmsrOk then
            WriteLn('EMB released');

          Wait4Return
        end;

        UMB := XMS_AllocUMB($FFFF);
        if Check(XMSResult, 'XMS_AllocUMB') = xmsrOk then
        begin
          WriteLn('UMB allocated at segment base ',
            Hex(TUMBAllocRec(UMB).SegAddr, 4), 'h');
          WriteLn('Actual size: ', TUMBAllocRec(UMB).Size, ' paragraphs'#10);
          if Check(XMS_FreeUMB(TUMBAllocRec(UMB).SegAddr),
            'XMS_FreeUMB') = xmsrOk then WriteLn('UMB released')
        end;
      end else WriteLn('XMS not present.')
    End.

[Back to MEMORY SWAG index] [Back to Main SWAG index] [Original]