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


1) use pointer
2) use XMS or EMS


1) Pointer
***************************************


Type                      {**}
          Data = Array[1..2000] of Real;   { Data size must not exceed 64K }
          DataPtr = ^Data;
Const
          MaxVar = 20;        { Value of MaxVar can be anything }
                              { but you must have sufficient heap memory }
                              {                   ^^^^^^^^^^^^^^^^^^^^^^ }
Var
          Variable :Array[1..MaxVar] of DataPtr;


PROCEDURE AllocateVar;
Var
          i      :Word;
Begin
  If MaxAvail >= MaxVar*6*2000 Then     { Check Heap before allocate }
    For i := 1 to MaxVar do
      New (Variable[i])
  Else Begin
    Writeln ('This progam requir memory more ',MaxVar*6*2000-MaxAvail);
    Halt (1)
  End
End;


PROCEDURE ReleaseVar;
Var
          i      :Word;
Begin
  For i := 1 to MaxVar do
    Dispose (Variable[i])
End;


Begin
  AllocateVar;
  .
  .

         Usage Variable :-

         Variable[Range1]^[Range2] := Real_Data;
                   /|\      /|\
     1-MaxVar_______|        |______ 1-2000 follow upper declaration {**}

     Ex.
             For i := 1 to MaxVar do
                For j := 1 to 2000 do
                  Variable[i]^[j] := 0;
  .
  .
  ReleaseVar;
End.

--------------------------------------------------

2) Use XMS
***********************************



( this is include file xms.inc )
		       ^^^^^^^	

Const
      ERR_NOERR          = $00;         { No error                         }
      ERR_NOTIMPLEMENTED = $80;         { SpecIfied FUNCTION not known     }
      ERR_VDISKFOUND     = $81;         { VDISK-RAMDISK detected           }
      ERR_A20            = $82;         { Error at handler A20             }
      ERR_GENERAL        = $8E;         { General driver error             }
      ERR_UNRECOVERABLE  = $8F;         { Unrecoverable error              }
      ERR_HMANOTEXIST    = $90;         { HMA does not exist               }
      ERR_HMAINUSE       = $91;         { HMA already in use               }
      ERR_HMAMINSIZE     = $92;         { Not enough space in HMA          }
      ERR_HMANOTALLOCED  = $93;         { HMA not allocated                }
      ERR_A20STILLON     = $94;         { Handler A20 still on             }
      ERR_OUTOMEMORY     = $A0;         { Out of extEnded memory           }
      ERR_OUTOHANDLES    = $A1;         { All XMS handles in use           }
      ERR_INVALIDHANDLE  = $A2;         { Invalid handle                   }
      ERR_SHINVALID      = $A3;         { Source handle invalid            }
      ERR_SOINVALID      = $A4;         { Source offset invalid            }
      ERR_DHINVALID      = $A5;         { Destination handle invalid       }
      ERR_DOINVALID      = $A6;         { Destination offset invalid       }
      ERR_LENINVALID     = $A7;         { Invalid length for move FUNCTION }
      ERR_OVERLAP        = $A8;         { Illegal overlapping              }
      ERR_PARITY         = $A9;         { Parity error                     }
      ERR_EMBUNLOCKED    = $AA;         { UMB is unlocked                  }
      ERR_EMBLOCKED      = $AB;         { UMB is still locked              }
      ERR_LOCKOVERFLOW   = $AC;         { Overflow of UMB lock counter     }
      ERR_LOCKFAIL       = $AD;         { UMB cannot be locked             }
      ERR_UMBSIZETOOBIG  = $B0;         { Smaller UMB available            }
      ERR_NOUMBS         = $B1;         { No more UMB available            }
      ERR_INVALIDUMB     = $B2;         { Invalid UMB segment address      }

Type
      XMSRegs = record                  { Information for XMS call         }
                 AX,                    { Only registers AX, BX, DX and SI }
                 BX,                    { required, depEnding on called    }
                 DX,                    { FUNCTION along With a segment    }
                 SI,                    { address                          }
                 Segment :Word
      End;

Var
      XMSPtr :Pointer;      { Pointer to the extEnded memory manager (XMM) }
      XMSErr :Byte;         { Error code of the last operation             }

{**********************************************************************
* XMSInitOk : Initializes the routines for calling the XMS FUNCTIONs  *
**-------------------------------------------------------------------**
* Input   : None                                                      *
* Output  : TRUE, If an XMS driver was discovered, otherwise FALSE    *
* Info    : - The call of this FUNCTION must precede calls of all     *
*             all other PROCEDUREs and FUNCTIONs from this program.   *
**********************************************************************}

FUNCTION XMSInitOk :Boolean;
Var
        Regs :Registers;
        XR   :XMSRegs;

Begin
  Regs.AX := $4300;               { Determine availability of XMS manager }
  Intr ($2F,Regs);
  If (Regs.AL = $80) Then         { XMS manager found?                    }
    Begin                         { Yes                                   }
      Regs.AX := $4310;           { Determine entry point of XMM          }
      Intr ($2F,Regs);
      XMSPtr := ptr (Regs.ES,Regs.BX);      { Store address in glob. Var. }
      XMSErr := ERR_NOERR;                  { Still no error found        }
      XMSInitOk := true;              { Handler found, module initialized }
    End
  Else                                { No XMS handler installed }
   XMSInitOk := false
End;

{**********************************************************************
* XMSCall : General routine for calling an XMS FUNCTION               *
**-------------------------------------------------------------------**
* Input   : FctNo = Number of XMS FUNCTION to be called               *
*           XRegs = Structure With registers for FUNCTION call        *
* Info    : - Before calling this PROCEDURE, only those registers     *
*             can be loaded that are actually required for calling    *
*             the specIfied FUNCTION.                                 *
*           - After the XMS FUNCTION call, the contents of the        *
*             Various processor registers are copied to the           *
*             corresponding components of the passed structure.       *
*           - Before calling this PROCEDURE for the first time, the   *
*             XMSInit must be called successfully.                    *
**********************************************************************}

PROCEDURE XMSCall (FctNr :Byte; Var XRegs :XMSRegs);
Begin
  inline ( $8C / $D9 /                              { mov    cx,ds        }
           $51 /                                    { push   cx           }
           $C5 / $BE / $04 / $00 /                  { lds    di,[bp+0004] }
           $8A / $66 / $08 /                        { mov    ah,[bp+0008] }
           $8B / $9D / $02 / $00 /                  { mov    bx,[di+0002] }
           $8B / $95 / $04 / $00 /                  { mov    dx,[di+0004] }
           $8B / $B5 / $06 / $00 /                  { mov    si,[di+0006] }
           $8E / $5D / $08 /                        { mov    ds,[di+08]   }
           $8E / $C1 /                              { mov    es,cx        }
           $26 / $FF / $1E / XMSPtr /               { call   es:[XMSPTr]  }
           $8C / $D9 /                              { mov    cx,ds        }
           $C5 / $7E / $04 /                        { lds    di,[bp+04]   }
           $89 / $05 /                              { mov    [di],ax      }
           $89 / $5D / $02 /                        { mov    [di+02],bx   }
           $89 / $55 / $04 /                        { mov    [di+04],dx   }
           $89 / $75 / $06 /                        { mov    [di+06],si   }
           $89 / $4D / $08 /                        { mov    [di+08],cx   }
           $1F                                      { pop    ds           }
        );

  {-- Test for error code --------------------------------------------}

  If (XRegs.AX = 0) and (XRegs.BX >= 128) Then
    Begin
      XMSErr := Lo(XRegs.BX)                    { Error, store error code }
      {
       .
       .
       .
         Another error handling routine could follow here
       .
       .
       .
      }
    End
  Else
    XMSErr := ERR_NOERR                                { No error, all ok }
End;

{**********************************************************************
* XMSQueryVer: Returns the XMS version number and other status        *
*              information                                            *
**-------------------------------------------------------------------**
* Input   : VerNr = Gets the version number after the FUNCTION call   *
*                   (Format: 235 = 2.35)                              *
*           RevNr = Gets the revision number after the FUNCTION call  *
* Output  : TRUE, If HMA is available, otherwise FALSE                *
**********************************************************************}

PROCEDURE XMSQueryVerHMA (Var VerNr,RevNr :Integer; Var HMA :Boolean);
Var
        XR :XMSRegs;               { Registers for communication With XMS }

Begin
  XmsCall (0,XR);
  VerNr := Hi(XR.AX)*100 + (Lo(XR.AX) shr 4) * 10 + (Lo(XR.AX) and 15);
  RevNr := Hi(XR.BX)*100 + (Lo(XR.BX) shr 4) * 10 + (Lo(XR.BX) and 15);
  HMA := (XR.DX = 1)
End;

{**********************************************************************
* XMSGetHMA : Returns right to access the HMA to the caller.          *
**-------------------------------------------------------------------**
* Input   : LenB = Number of bytes to be allocated                    *
* Info    : TSR programs should only request the memory size that     *
*           they actually require, while applications should specIfy  *
*           the value $FFFF.                                          *
* Output  : TRUE, If the HMA could be made available,                 *
*           otherwise FALSE;                                          *
**********************************************************************}

FUNCTION XMSGetHMA (LenB :Word) :Boolean;
Var
         XR :XMSRegs;

Begin
  XR.DX := LenB;                             { Pass length in DX register }
  XmsCall (1,XR);                            { Call XMS FUNCTION #1       }
  XMSGetHMA := (XMSErr = ERR_NOERR)
End;

{**********************************************************************
* XMSReleaseHMA : Releases the HMA, making it possible to pass        *
*                 to other programs.                                  *
**-------------------------------------------------------------------**
* Input   : None                                                      *
* Info    : - Call this PROCEDURE before Ending a program If the      *
*             HMA was allocated beforehand through a call for         *
*             XMSGetHMA, because otherwise the HMA cannot be passed   *
*             to any programs called afterwards.                      *
*           - Calling this PROCEDURE causes the data stored in HAM    *
*             to be lost.                                             *
**********************************************************************}

PROCEDURE XMSReleaseHMA;
Var
          XR :XMSRegs;        { Call registers for communication With XMS }

Begin
  XmsCall (2,XR)              { Call XMS FUNCTION #2 }
End;

{**********************************************************************
* XMSA20OnGlobal: Switches on the A20 handler, making direct access   *
*                 to the HMA possible.                                *
**-------------------------------------------------------------------**
* None    : None                                                      *
* Info    : - For many computers, switching on the A20 handler is a   *
*             relatively time-consuming process. Only call this       *
*             PROCEDURE when it is absolutely necessary.              *
**********************************************************************}

PROCEDURE XMSA20OnGlobal;
Var
          XR :XMSRegs;             { Registers for communication With XMS }

Begin
  XmsCall (3,XR)                   { Call XMS FUNCTION #3 }
End;

{**********************************************************************
* XMSA20OffGlobal: A counterpart to the XMSA20OnGlobal PROCEDURE,     *
*                  this PROCEDURE switches the A20 handler back off,  *
*                  so that direct access to the HMA is no longer      *
*                  possible.                                          *
**-------------------------------------------------------------------**
* Input   : None                                                      *
* Info    : - Always call this PROCEDURE before Ending a program,     *
*             in case the A20 handler was switched on before via a    *
*             a call for XMSA20OnGlobal.                              *
**********************************************************************}

PROCEDURE XMSA20OffGlobal;
Var
          XR :XMSRegs;             { Registers for communication With XMS }

Begin
  XmsCall (4,XR)                   { Call XMS FUNCTION #4 }
End;

{**********************************************************************
* XMSA20OnLocal: See XMSA20OnGlobal                                   *
**-------------------------------------------------------------------**
* Input   : None                                                      *
* Info    : - This local PROCEDURE dIffers from the global PROCEDURE  *
*             in that it only switches on the A20 handler If it       *
*             hasn't already been called.                             *
**********************************************************************}

PROCEDURE XMSA20OnLocal;
Var
          XR :XMSRegs;             { Registers for communication With XMS }

Begin
  XmsCall (5,XR )                  { Call XMS FUNCTION #5 }
End;

{**********************************************************************
* XMSA20OffLocal : See XMSA29OffGlobal                                *
**-------------------------------------------------------------------**
* Input   : None                                                      *
* Info    : - This local PROCEDURE only dIffers from the global       *
*             PROCEDURE in that the A20 handler is only switched      *
*             off If hasn't already happened through a previous       *
*             call.                                                   *
**********************************************************************}

PROCEDURE XMSA20OffLocal;
Var
          XR :XMSRegs;             { Registers for communication With XMS }

Begin
  XmsCall (6,XR)                   { Call XMS FUNCTION #6 }
End;

{**********************************************************************
* XMSIsA20On : Returns the status of the A20 handler                  *
**-------------------------------------------------------------------**
* Input   : None                                                      *
* Output  : TRUE, If A20 handler is on, otherwise FALSE.              *
*           FALSE.                                                    *
**********************************************************************}

FUNCTION XMSIsA20On :Boolean;
Var
         XR :XMSRegs;              { Registers for communication With XMS }

Begin
  XmsCall (7,XR);                  { Call XMS FUNCTION #7        }
  XMSIsA20On := (XR.AX = 1)        { AX = 1 ---> Handler is free }
End;

{**********************************************************************
* XMSQueryFree : Returns the size of free extended memory and the     *
*                largest free block                                   *
**-------------------------------------------------------------------**
* Input   : TotFree: Gets the total size of free extended memory.     *
*           MaxBl  : Gets the size of the largest free block.         *
* Info    : - Both specIfications in kilobytes.                       *
*           - The size of the HMA is not included in the count,       *
*             even If it hasn't yet been assigned to a program.       *
**********************************************************************}

PROCEDURE XMSQueryFree (Var TotFree, MaxBl :Integer);
Var
          XR :XMSRegs;             { Registers for communication With XMS }

Begin
  XmsCall (8,XR);                  { Call XMS FUNCTION #8 }
  TotFree := XR.AX;                { Total size in AX     }
  MaxBl   := XR.DX                 { Free memory in DX    }
End;

{**********************************************************************
* XMSGetMem : Allocates an extended memory block (EMB)                *
**-------------------------------------------------------------------**
* Input   : LenKB : Size of requested block in kilobytes              *
* Output  : Handle for further access to block or 0, If no block      *
*           can be allocated. The appropriate error code would        *
*           also be in the global Variable, XMSErr.                   *
**********************************************************************}

PROCEDURE XMSGetMem (LenKb :Integer; Var Handle :Integer);
Var
         XR :XMSRegs;              { Registers for communication With XMS }

Begin
  XR.DX := LenKB;                  { Length passed in DX register }
  XmsCall (9,XR);                  { Call XMS FUNCTION #9         }
  Handle := XR.DX                  { Return handle                }
End;

{**********************************************************************
* XMSFreeMem : Releases previously allocated extEnded memory block    *
*              (EMB).                                                 *
**-------------------------------------------------------------------**
* Input   : Handle : Handle for access to the block returned when     *
*                    XMSGetMem was called.                            *
* Info    : - The contents of the EMB are irretrievably lost and      *
*             the handle becomes invalid when you call this PROCEDURE.*
*           - Before Ending a program, use this PROCEDURE to release  *
*             all allocated memory areas, so that they can be         *
*             allocated for the next program to be called.            *
**********************************************************************}

PROCEDURE XMSFreeMem (Handle :Integer);
Var
          XR :XMSRegs;             { Registers for communication With XMS }

Begin
  XR.DX := Handle;                 { Handle passed in DX register }
  XmsCall (10,XR)                  { Call XMS FUNCTION #10        }
End;

{**********************************************************************
* XMSCopy : Copies memory areas between extEnded memory and           *
*           conventional memory or Within the two memory groups.      *
**-------------------------------------------------------------------**
* Input   : FrmHandle  : Handle of memory area to be copied.          *
*           FrmOffset  : Offset in block being copied.                *
*           ToHandle   : Handle of memory area to which memory is     *
*                        being copied.                                *
*           ToOffset   : Offset in the target block.                  *
*           LenW       : Number of words to be copied.                *
* Info    : - To include normal memory in the operation, 0 must be    *
*             specIfied as the handle and the segment and offset      *
*             address must be specIfied as the offset in the usual    *
*             form (offset before segment).                           *
**********************************************************************}

PROCEDURE XMSCopy (FrmHandle :Integer; FrmOffset :LongInt;
                   ToHandle :Integer; ToOffset :LongInt; LenW :LongInt);
Type
          EMMS = record               { An extEnded memory move structure }
            LenB    :LongInt;         { Number of bytes to be moved       }
            SHandle :Integer;         { Source handle                     }
            SOffset :LongInt;         { Source offset                     }
            DHandle :Integer;         { Destination handle                }
            DOffset :LongInt;         { Destination offset                }
          End;

Var
          XR :XMSRegs;             { Registers for communication With XMS }
          Mi :EMMS;                { Gets EEMS                            }

Begin
  With Mi do                       { Prepare EMMS first }
    Begin
      LenB := 2 * LenW;
      SHandle := FrmHandle;
      SOffset := FrmOffset;
      DHandle := ToHandle;
      DOffset := ToOffset
    End;
  XR.Si := Ofs(Mi);               { Offset address of EMMS  }
  XR.Segment := Seg(Mi);          { Segment address of EMMS }
  XmsCall (11,XR)                 { Call XMS FUNCTION #11   }
End;

{**********************************************************************
* XMSLock : Locks an extEnded memory block from being moved by the    *
*           XMM, returning its absolute address at the same time.     *
**-------------------------------------------------------------------**
* Input   : Handle : Handle of memory area returned during a prev-    *
*                    ious call by XMSGetMem.                          *
* Output  : The linear address of the block of memory.                *
**********************************************************************}

FUNCTION XMSLock (Handle :Integer) :LongInt;
Var
         XR :XMSRegs;              { Registers for communication With XMS }

Begin
  XR.DX := Handle;                            { Handle of EMB          }
  XmsCall (12,XR);                            { Call XMS FUNCTION #12  }
  XMSLock := longint (XR.DX) shl 16 + XR.BX   { Compute 32 bit address }
End;

{**********************************************************************
* XMSUnlock : Releases a locked extEnded memory block again.          *
**-------------------------------------------------------------------**
* Input   : Handle : Handle of memory area returned during a prev-    *
*                    ious call by XMSGetMem.                          *
**********************************************************************}

PROCEDURE XMSUnLock (Handle :Integer);

Var
          XR :XMSRegs;             { Registers for communication With XMS }

Begin
  XR.DX := Handle;                 { Handle of EMB         }
  XmsCall (13,XR);                 { Call XMS FUNCTION #13 }
End;

{**********************************************************************
* XMSQueryInfo : Gets Various information about an extEnded memory    *
*                block that has been allocated.                       *
**-------------------------------------------------------------------**
* Input   : Handle : Handle of memory area                            *
*           Lock   : Variable, in which the lock counter is entered   *
*           LenKB  : Variable, in which the length of the block is    *
*                    entered in kilobytes                             *
*           FreeH  : Number of free handles                           *
* Info    : You cannot use this PROCEDURE to find out the start       *
*           address of a memory block, use the XMSLock FUNCTION       *
*           instead.                                                  *
**********************************************************************}

PROCEDURE XMSQueryInfo (Handle :Integer; Var Lock, LenKB :Integer;
                        Var FreeH :Integer);
Var
          XR :XMSRegs;             { Registers for communication With XMS }

Begin
  XR.DX := Handle;                 { Handle of EMB         }
  XmsCall( 14, XR );               { Call XMS FUNCTION #14 }
  Lock  := Hi( XR.BX );            { Evaluate register     }
  FreeH := Lo( XR.BX );
  LenKB := XR.DX
End;

{**********************************************************************
* XMSRealloc : Enlarges or shrinks an extEnded memory block prev-     *
*              iously allocated by XMSGetMem                          *
**-------------------------------------------------------------------**
* Input   : Handle   : Handle of memory area                          *
*           NewLenKB : New length of memory area in kilobytes         *
* Output  : TRUE, If the block was resized, otherwise FALSE           *
* Info    : The specIfied block cannot be locked!                     *
**********************************************************************}

FUNCTION XMSRealloc (Handle, NewLenKB :Integer) :Boolean;
Var
         XR :XMSRegs;              { Registers for communication With XMS }

Begin
  XR.DX := Handle;                        { Handle of EMB                 }
  XR.BX := NewLenKB;                      { New length in the BX register }
  XmsCall (15,XR);                        { Call XMS FUNCTION #15         }
  XMSRealloc := (XMSErr = ERR_NOERR)
End;

{**********************************************************************
* XMSGetUMB : Allocates an upper memory block (UMB).                  *
**-------------------------------------------------------------------**
* Input   : LenPara : Size of area to be allocated in paragraphs      *
*                     of 16 bytes each                                *
*           Seg     : Variable that gets the segment address of       *
*                     the allocated UMB in successful cases           *
*           MaxPara : Variable that specIfies the length of the       *
*                     largest available UMB in unsuccessful cases     *
* Output  : TRUE, If a UMB could be allocated, otherwise FALSE        *
* Info    : Warning! This FUNCTION is not supported by all XMS        *
*                    drivers and is extremely hardware-depEndent.     *
**********************************************************************}

FUNCTION XMSGetUMB (LenPara :Integer; Var Seg, MaxPara :Word) :Boolean;
Var
         XR :XMSRegs;              { Registers for communication With XMS }

Begin
  XR.DX := LenPara;                          { Desired length to      }
  XmsCall (16,XR);                           { Call XMS FUNCTION #16  }
  Seg := XR.BX;                              { Return segment address }
  MaxPara := XR.DX;                          { Length of largest UMB  }
  XMSGetUMB := (XMSErr = ERR_NOERR)
End;

{**********************************************************************
* XMSFreeUMB : Releases UMB previously allocated by XMSGetUMB.        *
**-------------------------------------------------------------------**
* Input   : Seg : Segment address of UMB being released               *
* Info    : Warning! This FUNCTION is not supported by all XMS        *
*                    drivers and is extremely hardware-depEndent.     *
**********************************************************************}

PROCEDURE XMSFreeUMB (Var Seg :Word);
Var
          XR :XMSRegs;              { Registers for communication wit XMS }

Begin
  XR.DX := Seg;                     { Segment address of UMB to DX }
  XmsCall (17,XR)                   { Call XMS FUNCTION #17        }
End;

FUNCTION XMSErrMsg (n :Byte) :String;
Begin
  Case n of
    $00 : XMSErrMsg := 'No error';
    $80 : XMSErrMsg := 'SpecIfied FUNCTION not known';
    $81 : XMSErrMsg := 'VDISK-RAMDISK detected';
    $82 : XMSErrMsg := 'Error at handler A20';
    $8E : XMSErrMsg := 'General driver error';
    $8F : XMSErrMsg := 'Unrecoverable error';
    $90 : XMSErrMsg := 'HMA does not exist';
    $91 : XMSErrMsg := 'HMA already in use';
    $92 : XMSErrMsg := 'Not enough space in HMA';
    $93 : XMSErrMsg := 'HMA not allocated';
    $94 : XMSErrMsg := 'Handler A20 still on';
    $A0 : XMSErrMsg := 'Out of extEnded memory';
    $A1 : XMSErrMsg := 'All XMS handles in use';
    $A2 : XMSErrMsg := 'Invalid handle';
    $A3 : XMSErrMsg := 'Source handle invalid';
    $A4 : XMSErrMsg := 'Source offset invalid';
    $A5 : XMSErrMsg := 'Destination handle invalid';
    $A6 : XMSErrMsg := 'Destination offset invalid';
    $A7 : XMSErrMsg := 'Invalid length for move FUNCTION';
    $A8 : XMSErrMsg := 'Illegal overlapping';
    $A9 : XMSErrMsg := 'Parity error';
    $AA : XMSErrMsg := 'UMB is unlocked';
    $AB : XMSErrMsg := 'UMB is still locked';
    $AC : XMSErrMsg := 'Overflow of UMB lock counter';
    $AD : XMSErrMsg := 'UMB cannot be locked';
    $B0 : XMSErrMsg := 'Smaller UMB available';
    $B1 : XMSErrMsg := 'No more UMB available';
    $B2 : XMSErrMsg := 'Invalid UMB segment address'
  End
End;


............................................................
This program below is example for upper include file.


Uses Dos,Crt,VKeys;

{$I VXMS.INC}

Type
        SampleData      = Array [1..64000] of Byte;
        ScreenType      = Array [0..200,0..319] of Byte;
        DataPtr         = ^SampleData;
        ScreenPtr       = ^ScreenType;
Const
        XMS_Require     = 1000;
Var
        XMS_Version,XMS_Revision              :Integer;
        HMA_Available                         :Boolean;
        Total_XMS_Free,XMS_Free_Max_Blk       :Integer;
        XMS_Handle                            :Integer;
        XMS_Start_Addr                        :LongInt;
        Data,Blank                            :DataPtr;
        Screen,DataTest                       :ScreenPtr;
        Ch                                    :Char;
        i,j                                   :Word;

Begin
  If XMSInitOk Then Begin
    Writeln ('XMS Driver detected');
    XMSQueryVerHMA (XMS_Version,XMS_Revision,HMA_Available);
    Writeln ('XMS Driver Version ',XMS_Version div 100,
             '.',XMS_Version mod 100);
    Writeln ('XMS Revision ',XMS_Revision div 100,'.',XMS_Revision mod 100);
    If HMA_Available Then Writeln ('HMA Available');
    XMSQueryFree (Total_XMS_Free,XMS_Free_Max_Blk);
    Dec (Total_XMS_Free,64);
    If XMS_Free_Max_Blk >= Total_XMS_Free Then Dec (XMS_Free_Max_Blk,64);
    Writeln ('XMS Largest free block ',XMS_Free_Max_Blk,' KByte(s)');
    If XMS_Free_Max_Blk < XMS_Require Then  Begin
      Writeln (#7,#13,#10,XMS_Require-XMS_Free_Max_Blk,' KByte(s) XMS memory ',
               'need more.');
      Halt (0)
    End
    Else Begin
      XMSGetMem (XMS_Require,XMS_Handle);
      Writeln ('XMS Allocated');
      XMS_Start_Addr := XMSLock (XMS_Handle);
      XMSUnLock (XMS_Handle);
      New (Data);
      New (Blank);
      For i := 1 to 64000 do Begin
        Data^[i] := (i-1) mod 255;
        Blank^[i] := 0;
      End;
      For i := 1 to Round(XMS_Require/(32000*2/1024)) do
        XMSCopy (0,Longint(Data),XMS_Handle,LongInt(i-1)*1024*50,32000);
      Screen := Ptr ($A000,0);
      New (DataTest);
      XMSCopy (0,LongInt(Data),0,LongInt(DataTest),32000);
      ASM MOV AX,13h; INT 10h End;
      Repeat
        XMSCopy (XMS_Handle,0,0,LongInt(Screen),32000);
        XMSCopy (0,LongInt(Blank),0,LongInt(Screen),32000);
      Until KeyPressed;
      ASM MOV AX,3; INT 10h End;
{      For i := 0 to 199 do
        For j := 0 to 319 do
          Write (DataTest^[i][j]:8);
      Ch := ReadKey;}
      XMSFreeMem (XMS_Handle)
    End
  End
  Else Begin
    Writeln (#7,#13,#10,'XMS Driver not load.')
  End
End.

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