;****************************************************************************
; XMS.ASM - Extended memory interface for QuickBASIC programs.
;
; (C) Copyright 1992 by Sequential Software. All rights reserved.
; Author: Robin Duffy.
;
; See the headers for each public routine on calling syntax and operating
; notes. Use of extended memory requires HIMEM.SYS to be installed via
; CONFIG.SYS and a 80286 or later processor. Each procedure may be
; called at any time, even if no XMS is installed on the host machine.
;
; Assembled with Turbo Assembler 2.5
;****************************************************************************
.Model Medium, Basic

.Data

XError    db   80h                      ;Storage for errors, assumes no XMS
XMSThere  dw   0                        ;XMS available flag, assumes no XMS
XMove     dw   8 Dup(?)                 ;Buffer for array move routines

.Code

XMSDriver dw ?,?                        ;Local storage for HIMEM entry point

                    Public    InitXMS
;****************************************************************************
; Procedure to check for HIMEM.SYS and initialize a few things. This routine
; must be called prior to calling any of the other procedures.
;
; Syntax: CALL InitXMS(There%, MemSize%)
; Returns:     There% =  0 No XMS available
;                     = -1 XMS available
;
;            MemSize% = Size of available XMS in K bytes.
;                       Valid only if There% is not zero.
;****************************************************************************
Proc InitXMS   Uses ES, There:Ptr Word, MemSize:Ptr Word

    Mov   AX,4300h                      ;Prepare to do installation check
    Int   2fh                           ;Use the multiplex interrupt
    Cmp   AL,80h                        ;Is HIMEM.SYS installed?
    Jnz   InitExit                      ;Nope, get on out

    Mov   AX,4310h                      ;Get the driver entry point
    Int   2fh

    Mov   CS:XMSDriver,BX               ;Store the offset of entry point
    Mov   BX,ES
    Mov   CS:XMSDriver[2],BX            ;And the segment of entry point

    Sub   BL,BL                         ;HIMEM does not clear this
    Mov   AX,0800h
    Call  DWord Ptr CS:XMSDriver        ;Find available extended memory size
    Or    BL,BL                         ;Did an error occur?
    Jnz   InitExit                      ;Yes, so get out now

    Cmp   AX,0                          ;Is there any left for us?
    Jz    InitExit                      ;No, exit now

    Mov   BX,MemSize
    Mov   [BX],AX                       ;Report the available size
    Dec   XMSThere                      ;Mark our flag to -1 (XMS is good)
    Mov   XError,0                      ;Clear the error variable

InitExit:
    Mov   AX,XMSThere
    Mov   BX,There
    Mov   [BX],AX                       ;Report results to BASIC
    Ret                                 ;And return

InitXMS   EndP


                    Public    GetXMS
;***************************************************************************
; Procedure to allocate extended memory for the program. Because this is a
; function, it must be declared before it may be used.
; Syntax: Handle% = GetXMS(Size%)
;         where Handle% receives the XMS handle. All further references to
;         this block require this handle (much like DOS file handles). A
;         handle of 0 means an error allocating the memory.  This system
;         allows multiple blocks to be managed by the parent program.
;
;         Size% is the requested memory size in K bytes.
;***************************************************************************
GetXMS    Proc Amount:Ptr

     Cmp  XMSThere,-1                   ;Any point in continuing?
     Jnz  GetExit                       ;Nope.

     Mov BX,Amount
     Mov  DX,[BX]                       ;Get the K requested by user

     Sub  BL,BL
     Mov  AX,0900h
     Call DWord Ptr CS:XMSDriver        ;Ask HIMEM for it
     Mov  XError,BL                     ;Save error code

     Cmp  AL,1                          ;Was it allocated?
     Jz   AllOK                         ;Yes, go return handle
     Sub  DX,DX                         ;Otherwise return handle of zero

AllOK:
     Mov  AX,DX                         ;Return handle as function output

GetExit:
     Ret                                ;Return to BASIC

GetXMS    EndP

                    Public    FreeXMS
;***************************************************************************
; Procedure to release extended memory blocks.
;
; Syntax: CALL FreeXMS(Handle%)
;         where Handle% is the block handle assigned by GetXMS.  This should
;         be called prior to exiting your program. Unlike conventional
;         memory, extended memory is not automatically released by DOS
;         when the program ends. The memory remains allocated.
;***************************************************************************
FreeXMS   Proc Uses SI, Handle:Ptr Word

     Cmp  XMSThere,-1                   ;Any point in continuing?
     Jnz  FreeExit                      ;Nope.

     Mov  SI,Handle
     Call CheckHandle                   ;Make sure it is a valid handle
     Cmp  XError,0                      ;Error occur?
     Jnz  FreeExit                      ;Yes, get out now!
     
     Mov  DX,[SI]                       ;Place user handle in DX
     Sub  BL,BL
     Mov  AX,0a00h
     Call DWord Ptr CS:XMSDriver        ;Tell HIMEM to release the block
     Mov  XError,BL                     ;Save error code
     
FreeExit:
     Ret                                ;And return to BASIC

FreeXMS   EndP


                    Public    Array2XMS
;****************************************************************************
; Procedure to move a block of memory from conventional to XMS memory.
;
;Syntax: CALL Array2XMS(BYVAL FromSeg%, BYVAL FromOffset%, Handle%, NumBytes&)
;                             or
;         CALL Array2XMS(SEG Array(1), Handle%, Numbytes&)
;
;         FromSeg% = Segment of source block
;         FromOffset% = Offset of source block
;         Handle% = XMS handle assigned by GetXMS
;         NumBytes& = number of bytes to move (must be even)
;                     if a constant is used, it must be declared long
;
;****************************************************************************
Array2XMS Proc Uses SI, SSeg:Ptr Word, SOff:Ptr Word, Handle:Ptr Word,\
                        Bytes:Ptr Word
                                
     Cmp  XMSThere,-1                   ;Any point in continuing?
     Jnz  Mov1Exit                      ;Nope.

     Mov  SI, Handle                    ;Pass handle address to CheckHandle
     Call CheckHandle                   ;See if the handle is defined
     Cmp  XError,0                      ;If error then exit
     Jnz  Mov1Exit                      ;Exit with error already set

     Mov  SI,Offset XMove               ;Get location of our XMS structure

     Mov  BX,Bytes                      ;Starts with number of bytes to move
     Mov  AX,[BX]                       ;Read low word
     Mov  DX,[BX+2]                     ;Read high word (long integer)

     Test AX,1                          ;Is it odd?
     Jz   IsEven                        ;No, it's OK
     Dec  AX                            ;Force it even
     
IsEven:
     Mov  [SI],AX                       ;Load low word of number of bytes
     Mov  [SI+2],DX                     ;Load the high word

     Mov  Word Ptr [SI+4],0             ;Source handle is conventional memory
     Mov  BX,SOff                       ;Load source offset
     Mov  [SI+6],BX
     Mov  BX,SSeg                       ;Load source segment
     Mov  [SI+8],BX

     Mov  BX,Handle                     ;Load destination XMS handle
     Mov  AX,[BX]
     Mov  [SI+10],AX
     
     Mov  Word Ptr [SI+12],0           ;Offset 0 into XMS block
     Mov  Word Ptr [SI+14],0

     Sub  BL,BL
     Mov  AX,0b00h                      ;Ask HIMEM to do it for us
     Call DWord Ptr CS:XMSDriver        
     Mov  XError,BL                     ;Save the error code

Mov1Exit:
     Ret                                ;Back to the BASIC's....

Array2XMS EndP

                    Public    XMS2Array
;***************************************************************************
; Procedure to move a block from XMS to conventional memory.
;
; Syntax: CALL XMS2Array(Handle%, BYVAL ToSeg%, BYVAL ToOffset%, NumBytes&)
;                             or
;         CALL Array2XMS(Handle%, SEG Array(1), Numbytes&)
;
;         Handle% = XMS handle assigned by GetXMS
;         ToSeg% = Segment of destination block
;         ToOff% = Offset of destination block
;         NumBytes& = number of bytes to move (must be even)
;****************************************************************************
XMS2Array Proc Uses SI, Handle:Ptr Word, ToSeg:Ptr Word, ToOff:Ptr Word,\
                        Bytes:Ptr Word

     Cmp  XMSThere,-1                   ;Any point in continuing?
     Jnz  Mov2Exit                      ;Nope.

     Mov  SI, Handle                    ;Pass handle address to CheckHandle
     Call CheckHandle                   ;See if the handle is defined
     Cmp  XError,0                      ;If error then exit
     Jnz  Mov2Exit                      ;Exit with error already set

     Mov  SI,Offset XMove               ;Get location of our XMS structure
     
     Mov  BX,Bytes                      ;Starts with number of bytes to move
     Mov  AX,[BX]                       ;Read the low word
     Mov  DX,[BX+2]                     ;Read the high word (long integer)
     
     Test AX,1                          ;Is it odd?
     Jz   Is2Even                       ;They read the manual again!
     Dec  AX                            ;Force it even

Is2Even:
     Mov  [SI],AX                       ;Load low word
     Mov  [SI+2],DX                     ;Now the high one

     Mov  BX,Handle                     ;Load the XMS source block handle
     Mov  AX,[BX]
     Mov  [SI+4],AX

     Mov  Word Ptr [SI+6],0            ;Offset 0 into XMS block
     Mov  Word Ptr [SI+8],0

     Mov  Word Ptr [SI+10],0            ;Destination is conventional memory
     Mov  BX,ToOff                      ;Load destination offset
     Mov  [SI+12],BX
     Mov  BX,ToSeg                      ;Load destination segment
     Mov  [SI+14],BX

     Sub BL,BL
     Mov  AX,0b00h                      ;Ask HIMEM to do it for us
     Call DWord Ptr CS:XMSDriver        
     Mov  XError,BL                     ;Save the error code

Mov2Exit:
     Ret                                ;Back to the BASIC's....

XMS2Array EndP

                    Public XGetElement
;***************************************************************************
; Procedure to return any continuous portion of an array stored in XMS.
;
; Syntax: CALL GetElement(Handle%, Variable, EleLen%, EleNum%)
;    where Handle% - handle assigned by GetXMS
;          Variable - variable (TYPE, fixed string, or integer) to set
;          EleLen% - length of the variable in bytes
;          EleNum% - element number to retrieve
;
; Variable can be any variable type except a conventional string. It
; should be noted that EleLen% should be even. Also, this procedure
; assumes the first element of the array is element number one. That is,
; assume all arrays are one-based.
;***************************************************************************
XGetElement     Proc Uses SI, Handle:Ptr Word, Vari:Ptr Word, EleLen:Ptr Word,\
                             EleNum:Ptr Word

     Cmp  XMSThere,-1                   ;Any point in continuing?
     Jnz  GEExit                        ;Nope.

     Mov  SI, Handle                    ;Pass handle address to CheckHandle
     Call CheckHandle                   ;See if the handle is defined
     Cmp  XError,0                      ;If error then exit
     Jnz  GEExit                        ;Exit with error already set

     Mov  XError,0a7h                   ;Assume a syntax error
     Mov  SI,Offset XMove               ;Location of our move buffer
     Sub  DX,DX                         ;Make sure DX is zero (oops!)

     Mov  BX,EleLen                     ;Get the length of the variable
     Mov  AX,[BX]                       ;Load into AX
     Test AX,1                          ;Is it odd?
     Jz   Is3Even                       ;No, it's OK.

     Dec  AX                            ;Make it even
     Or   AX,AX                         ;It's not zero, is it?
     Jnz  Is3Even                       ;No, it's OK.
     Jmp  Short GEExit                  ;It is zero, leave now

Is3Even:
     Mov  BX,EleNum                     ;Get the element to get
     Mov  CX,[BX]                       ;into CX
     Jcxz GEExit                        ;If element is 0, forget it

     Mov  XError,0                      ;We are OK here, clear error status
     Mov  [SI],AX                       ;EleLen is number of bytes to move
     Mov  [SI+2],DX                     ;High word should be zero.....

     Dec  CX                            ;Adjust CX to zero base
     Mul  CX                            ;Find offset into block
                                        ;DX:AX holds 32 bit offset into block
     Mov  BX,Handle                     ;Find our source handle
     Mov  CX,[BX]
     Mov  [SI+4],CX                     ;Move handle into buffer
     Mov  [SI+6],AX                     ;Low word of 32 bit offset
     Mov  [SI+8],DX                     ;High word of offset

     Mov  Word Ptr [SI+10],0            ;Destination handle is convential mem
     Mov  BX,Vari                       ;Get offset of variable from BASIC
     Mov  [SI+12],BX                    ;Load offset into structure
     Mov  [SI+14],DS                    ;Set segment to DS

     Sub BL,BL
     Mov  AX,0b00h                      ;Ask HIMEM to do it for us
     Call DWord Ptr CS:XMSDriver
     Mov  XError,BL                     ;Save the error code

GEExit:
     Ret                                ;Back to BASIC

XGetElement     EndP


                    Public XSetElement
;***************************************************************************
; Procedure to set any continuous portion of an array stored in XMS.
;
; Syntax: CALL SetElement(Handle%, Variable, EleLen%, EleNum%)
;    where Handle% - handle assigned by GetXMS
;          Variable - variable (TYPE, fixed string, etc) to place in XMS
;          EleLen% - length of the variable in bytes
;          EleNum% - element number to write to
;
; Variable can be any variable type except a conventional string. It
; should be noted that EleLen% should be even. Also, this procedure
; assumes the first element of the array is element number one. That is,
; assume all arrays are one-based.
;***************************************************************************
XSetElement    Proc Uses SI, Handle:Ptr Word, Vari:Ptr Word, EleLen:Ptr Word,\
                             EleNum:Ptr Word

     Cmp  XMSThere,-1                   ;Any point in continuing?
     Jnz  SEExit                        ;Nope.

     Mov  SI, Handle                    ;Pass handle address to CheckHandle
     Call CheckHandle                   ;See if the handle is defined
     Cmp  XError,0                      ;If error then exit
     Jnz  SEExit                        ;Exit with error already set

     Mov  XError,0a7h                   ;Assume a syntax error
     Mov  SI,Offset XMove               ;Location of our move buffer
     Sub  DX,DX                         ;Make sure DX is zero (oops again!)

     Mov  BX,EleLen                     ;Get the length of the variable
     Mov  AX,[BX]                       ;Load into AX
     Test AX,1                          ;Is it odd?
     Jz   Is4Even                       ;No, it's OK.

     Dec  AX                            ;Make it even
     Or   AX,AX                         ;It's not zero, is it?
     Jnz  Is4Even                       ;No, it's OK.
     Jmp  Short SEExit                  ;It is zero, leave now

Is4Even:
     Mov  BX,EleNum                     ;Get the element to write to
     Mov  CX,[BX]                       ;into CX
     Jcxz SEExit                        ;If element is 0, forget it

     Mov  XError,0                      ;We are OK here, clear error status
     Mov  [SI],AX                       ;EleLen is number of bytes to move
     Mov  [SI+2],DX                     ;High word should be zero

     Dec  CX                            ;Adjust CX to zero base
     Mul  CX                            ;Find offset into block
                                        ;DX:AX holds 32 bit offset into block
     Mov  Word Ptr [SI+4],0             ;Source handle is convential mem
     Mov  BX,Vari                       ;Get offset of variable from BASIC
     Mov  [SI+6],BX                     ;Load offset into structure
     Mov  [SI+8],DS                     ;Set segment to DS in structure

     Mov  BX,Handle                     ;Find our source handle
     Mov  CX,[BX]
     Mov  [SI+10],CX                    ;Move handle into buffer
     Mov  [SI+12],AX                    ;Low word of 32 bit offset in buffer
     Mov  [SI+14],DX                    ;High word of offset in buffer

     Sub BL,BL
     Mov  AX,0b00h                      ;Ask HIMEM to do it for us
     Call DWord Ptr CS:XMSDriver
     Mov  XError,BL                     ;Save the error code

SEExit:
     Ret                                ;Back to BASIC

XSetElement     EndP

                    Public    XMSError
;****************************************************************************
; Procedure to report success of last XMS operation. Because this is a
; function, It must be declared before it may be used.
;
; Syntax: C% = XMSError%
;
;    returns C% = 0  Last operation successful
;            C% = -1 Last operation resulted in error
;
;    This function will always show an error if XMS is not available.
;****************************************************************************
XMSError  Proc

     Mov  AX,-1                    ;Assume an error
     Cmp  XMSThere,0               ;Is XMS available?
     Jz   ExitErr                  ;No, exit now with error

     Mov  BL,XError                ;Load error byte in
     Or   BL,BL                    ;Anything there?
     Jnz  ExitErr                  ;Yes, report an error
     Inc  AX                       ;Make it a 0 to show no error

ExitErr:
     Ret                           ;Back to BASIC with output in AX

XMSError  EndP

                    Public    WhichXError
;***************************************************************************
; Procedure that returns the current value of XError. Because this is a
; function, it must be declared before it may be used. It should be noted
; that any sucessful call to any procedure in this file will clear XError.
;
; Syntax:  Code% = WhichXError%
;    where Code% receives the value of XError.
;***************************************************************************
WhichXError    Proc

     Mov  AL,XError                     ;Load AL with the error
     Xor  AH,AH                         ;Clear AH
     Ret                                ;Return to BASIC

WhichXError    EndP

                    Public    SetXError
;****************************************************************************
; This procedure allows direct setting of the XError variable to force
; error codes. Useful for communications between modules.
;
; Syntax: CALL SetXError(ErrCode%)
;    where ErrCode% is a value between 0 - 255 inclusive.
;
; Note: If XMS is not installed, this function will not have any effect.
;****************************************************************************
SetXError Proc ErrCode:Ptr Word

     Cmp  XMSThere,-1                   ;Can we set error codes?
     Jnz  SetExit                       ;No, skip this
     
     Mov  BX,ErrCode                    ;Get the user's error code
     Mov  AX,[BX]                       ;into AX
     Mov  XError,AL                     ;Load it

SetExit:
     Ret                                ;Back to BASIC

SetXError EndP

;****************************************************************************
; CheckHandle - Procedure to test the validity of a user passed handle. For
;               some reason HIMEM.SYS does not seem to check the validity of
;               the handle on any function call but this one!  If not tested
;               an invalid handle will lock the machine.
;
; On Entry: SI - pointer to address of user passed handle
;
; On Exit: DX - block size associated with handle
;          XError - set to invalid handle if invalid, otherwise clear
;****************************************************************************

CheckHandle    Proc Near
     Mov  DX,[SI]                       ;Put the handle in DX
     Or   DX,DX                         ;Handle of zero?
                                        ;Note: I test for a zero handle
                                        ;becuase 0 is a valid handle for
                                        ;HIMEM (conventional memory) but is
                                        ;NOT valid for any user calls.
     Jnz  DXOK                          ;It's not, go on
     Mov  XError,0a2h                   ;Set "Invalid Handle" error
     Jmp Short CHExit                   ;And exit

DXOK:
     Sub  BL,BL                         ;Clear BL for HIMEM
     Mov  XError,BL                     ;and the error code

     Mov  AX,0e00h
     Call DWord Ptr CS:XMSDriver        ;Ask HIMEM about this handle

     Cmp  AX,1                          ;Was it successful?
     Je   CHExit                        ;Yes, exit now
     Mov  XError,BL                     ;Save the error code

CHExit:
     Ret
CheckHandle    EndP

End 
