home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / memory.swg / 0038_XMS Memory Access Unit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-09-26  |  11.0 KB  |  305 lines
  1. {---------------- Extended Memory Access Unit -----------------}
  2. UNIT XMS;
  3. (**) INTERFACE (**)
  4. VAR
  5.   XMSErrorCode : byte;     { Error Code - Defined in XMS Spec }
  6.   XMSAddr      : Pointer;  { Entry Point for HIMEM.SYS Driver }
  7.  
  8. FUNCTION XMSDriverLoaded: Boolean;
  9. FUNCTION XMSTotalMemoryAvailable: Word;
  10. FUNCTION XMSLargestBlockAvailable: Word;
  11. FUNCTION XMSAllocateBlock(KBSize: Word): Word;
  12. FUNCTION XMSReleaseBlock(Handle: Word): Boolean;
  13. FUNCTION XMSMoveDataTo(SourceAddr: Pointer; NumBytes: LongInt;
  14.            XMSHandle: Word; XMSOffset: LongInt): Boolean;
  15. FUNCTION XMSGetDataFrom(XMSHandle: Word; XMSOffset: LongInt;
  16.            NumBytes: LongInt; LowMemAddr: Pointer): Boolean;
  17.  
  18. (**) IMPLEMENTATION (**)
  19.  
  20. TYPE
  21.   XMSMoveStruct = record
  22.     movelen   : LongInt;   { length of block to move in bytes }
  23.     case integer of
  24.       { Case 0 Variant for Low Memory to XMS }
  25.       0: (SHandle   : Word;      { source handle = 0
  26.                                    for conventional memory }
  27.           SPtr      : pointer;   { source address }
  28.           XMSHdl    : Word;      { XMS destination handle }
  29.           XMSOffset : LongInt);  { 32 bit XMS offset }
  30.       { Case 1 Variant for XMS to Low Memory }
  31.       1: (XMSH      : Word;      { XMS source handle }
  32.           XMSOfs    : LongInt;   { starting offset in XMS}
  33.           DHandle   : Word;      { 0 when conventional memory
  34.                                    destination }
  35.           DPtr      : pointer);  { address in conventional memory }
  36.     END;
  37.  
  38. VAR moveparms : XMSMoveStruct;   { structure for moving to and
  39.                                    from XMS }
  40.  
  41. {**************************************************************}
  42. { XMSDriverLoaded - Returns true IF Extended Memory Driver     }
  43. {                   HIMEM.SYS Loaded                           }
  44. {                 - Sets Entry Point Address - XMSAddr         }
  45. {**************************************************************}
  46. FUNCTION XMSDriverLoaded: Boolean;
  47. CONST
  48.   himemseg: Word = 0;
  49.   himemofs: Word = 0;
  50. BEGIN
  51.   XMSErrorCode := 0;
  52.   ASM
  53.     mov ax,4300h      { Check to see IF HIMEM.SYS installed }
  54.     int 2fh
  55.     cmp al,80h        { Returns AL = 80H IF installed }
  56.     jne @1
  57.     mov ax,4310h      { Now get the entry point }
  58.     int 2fh
  59.     mov himemofs,bx
  60.     mov himemseg,es
  61.   @1:
  62.   END;
  63.   XMSDriverLoaded := (himemseg <> 0);
  64.   XMSAddr := Ptr(himemseg,himemofs);
  65. END;
  66.  
  67. {**************************************************************}
  68. { XMSTotalMemoryAvailable - Returns Total XMS Memory Available }
  69. {**************************************************************}
  70. FUNCTION XMSTotalMemoryAvailable: Word;
  71. BEGIN
  72.   XMSErrorCode := 0;
  73.   XMSTotalMemoryAvailable := 0;
  74.   IF XMSAddr = nil THEN        { Check IF HIMEM.SYS Loaded }
  75.     IF NOT XMSDriverLoaded THEN exit;
  76.   ASM
  77.     mov  ah,8
  78.     call XMSAddr
  79.     or   ax,ax
  80.     jnz  @1
  81.     mov  XMSErrorCode,bl  { Set Error Code }
  82.     xor  dx,dx
  83.     @1:
  84.     mov  @Result,dx       { DX = total free extended memory }
  85.   END;
  86. END;
  87.  
  88. {**************************************************************}
  89. { XMSLargestBlockAvailable - Returns Largest Contiguous        }
  90. {                            XMS Block Available               }
  91. {**************************************************************}
  92. FUNCTION XMSLargestBlockAvailable: Word;
  93. BEGIN
  94.   XMSErrorCode := 0;
  95.   XMSLargestBlockAvailable := 0;
  96.   IF XMSAddr = nil THEN         { Check IF HIMEM.SYS Loaded }
  97.     IF NOT XMSDriverLoaded THEN exit;
  98.   ASM
  99.     mov  ah,8
  100.     call XMSAddr
  101.     or   ax,ax
  102.     jnz  @1
  103.     mov  XMSErrorCode,bl { On Error, Set Error Code }
  104.     @1:
  105.     mov  @Result,ax      { AX=largest free XMS block }
  106.   END;
  107. END;
  108.  
  109. {***************************************************************}
  110. { XMSAllocateBlock - Allocates Block of XMS Memory              }
  111. {                  - Input - KBSize: No of Kilobytes requested  }
  112. {                  - Returns Handle for memory IF successful    }
  113. {***************************************************************}
  114. FUNCTION XMSAllocateBlock(KBSize: Word): Word;
  115. BEGIN
  116.   XMSAllocateBlock := 0;
  117.   XMSErrorCode := 0;
  118.   IF XMSAddr = nil THEN { Check IF HIMEM.SYS Loaded }
  119.     IF NOT XMSDriverLoaded THEN exit;
  120.   ASM
  121.     mov  ah,9
  122.     mov  dx,KBSize
  123.     call XMSAddr
  124.     or   ax,ax
  125.     jnz  @1
  126.     mov  XMSErrorCode,bl { On Error, Set Error Code }
  127.     xor  dx,dx
  128.     @1:
  129.     mov  @Result,dx      { DX = handle for extended memory }
  130.   END;
  131. END;
  132.  
  133. {**************************************************************}
  134. { XMSReleaseBlock - Releases Block of XMS Memory               }
  135. {                 - Input:   Handle identifying memory to be   }
  136. {                   released                                   }
  137. {                 - Returns  true IF successful                }
  138. {**************************************************************}
  139. FUNCTION XMSReleaseBlock(Handle: Word): Boolean;
  140. VAR OK : Word;
  141. BEGIN
  142.   XMSErrorCode := 0;
  143.   XMSReleaseBlock := false;
  144.   IF XMSAddr = nil THEN   { Check IF HIMEM.SYS Loaded }
  145.     IF NOT XMSDriverLoaded THEN exit;
  146.   ASM
  147.     mov  ah,0Ah
  148.     mov  dx,Handle
  149.     call XMSAddr
  150.     or   ax,ax
  151.     jnz  @1
  152.     mov  XMSErrorCode,bl  { On Error, Set Error Code }
  153.     @1:
  154.     mov  OK,ax
  155.   END;
  156.   XMSReleaseBlock := (OK <> 0);
  157. END;
  158.  
  159. {**************************************************************}
  160. { XMSMoveDataTo - Moves Block of Data from Conventional        }
  161. {                 Memory to XMS Memory                         }
  162. {               - Data Must have been previously allocated     }
  163. {               - Input - SourceAddr : address of data in      }
  164. {                                      conventional memory     }
  165. {                       - NumBytes   : number of bytes to move }
  166. {                       - XMSHandle  : handle of XMS block     }
  167. {                       - XMSOffset  : 32 bit destination      }
  168. {                                      offset in XMS block     }
  169. {               - Returns true IF completed successfully       }
  170. {**************************************************************}
  171. FUNCTION XMSMoveDataTo(SourceAddr: Pointer; NumBytes: LongInt;
  172.            XMSHandle: Word; XMSOffset: LongInt): Boolean;
  173. VAR Status    : Word;
  174. BEGIN
  175.   XMSErrorCode := 0;
  176.   XMSMoveDataTo := false;
  177.   IF XMSAddr = nil THEN  { Check IF HIMEM.SYS Loaded }
  178.     IF NOT XMSDriverLoaded THEN exit;
  179.   MoveParms.MoveLen   := NumBytes;
  180.   MoveParms.SHandle   := 0;         { Source Handle=0 For
  181.                                       Conventional Memory}
  182.   MoveParms.SPtr      := SourceAddr;
  183.   MoveParms.XMSHdl    := XMSHandle;
  184.   MoveParms.XMSOffset := XMSOffset;
  185.   ASM
  186.     mov  ah,0Bh
  187.     mov  si,offset MoveParms
  188.     call XMSAddr
  189.     mov  Status,ax       { Completion Status }
  190.     or   ax,ax
  191.     jnz  @1
  192.     mov  XMSErrorCode,bl { Save Error Code }
  193.     @1:
  194.   END;
  195.   XMSMoveDataTo := (Status <> 0);
  196. END;
  197.  
  198. {**************************************************************}
  199. { XMSGetDataFrom - Moves Block From XMS to Conventional Memory }
  200. {                - Data Must have been previously allocated    }
  201. {                  and moved to XMS                            }
  202. {               - Input - XMSHandle  : handle of source        }
  203. {                                      XMS block               }
  204. {                       - XMSOffset  : 32 bit source offset    }
  205. {                                      in XMS block            }
  206. {                       - NumBytes   : number of bytes to move }
  207. {                       - LowMemAddr : destination addr in     }
  208. {                                      conventional memory     }
  209. {               - Returns true IF completed successfully       }
  210. {**************************************************************}
  211. FUNCTION XMSGetDataFrom(XMSHandle: Word; XMSOffset: LongInt;
  212.            NumBytes: LongInt; LowMemAddr: Pointer): Boolean;
  213. VAR Status    : Word;
  214. BEGIN
  215.   XMSErrorCode := 0;
  216.   XMSGetDataFrom := false;
  217.   IF XMSAddr = nil THEN   { Check IF HIMEM.SYS Loaded }
  218.     IF NOT XMSDriverLoaded THEN exit;
  219.   MoveParms.MoveLen := NumBytes;  { Set-Up Structure to Pass }
  220.   MoveParms.XMSh    := XMSHandle;
  221.   MoveParms.XMSOfs  := XMSOffset;
  222.   MoveParms.DHandle := 0;         { Dest Handle=0 For
  223.                                     Conventional Memory}
  224.   MoveParms.DPtr    := LowMemAddr;
  225.   ASM
  226.     mov  ah,0Bh
  227.     mov  si,offset MoveParms
  228.     call XMSAddr
  229.     mov  Status,ax       { Completion Status }
  230.     or   ax,ax
  231.     jnz  @1
  232.     mov  XMSErrorCode,bl { Set Error Code }
  233.     @1:
  234.   END;
  235.   XMSGetDataFrom := (Status <> 0);
  236. END;
  237.  
  238. BEGIN
  239.   XMSAddr      := nil; { Initialize XMSAddr }
  240.   XMSErrorCode := 0;
  241. END.
  242.  
  243. { *********************************************************************** }
  244. { *********************************************************************** }
  245. { *********************************************************************** }
  246. {                                XMS DEMO PROGRAM                         }
  247.  
  248. {$X+}
  249. Program XMSTest;
  250. USES crt, XMS;
  251. CONST
  252.   NumVars     = 131072;   { 131072 total no of variables in array }
  253.   BytesPerVar = 4;        { ie. 2 for integers, 4 for LongInts ...}
  254. VAR
  255.   I       : LongInt;
  256.   Result  : LongInt;
  257.   Hdl     : Word;          { Handle for Extended memory allocated }
  258.   HiMemOK : boolean;
  259. BEGIN
  260.   ClrScr;
  261.   HiMemOK := XMSDriverLoaded;
  262.   WriteLn('HIMEM.SYS Driver Loaded=', HiMemOK);
  263.   IF NOT HiMemOK THEN Halt;
  264.   WriteLn('Total Extended Memory: ', XMSTotalMemoryAvailable, ' KB');
  265.   WriteLn('Largest Free Extended Memory Block: ',
  266.            XMSLargestBlockAvailable, ' KB');
  267.  
  268.   {Allocate Memory - Hdl is memory block handle or identifier}
  269.   Hdl := XMSAllocateBlock((NumVars * BytesPerVar + 1023) DIV 1024);
  270.          {1023 to Round Up to next KB}
  271.   WriteLn((NumVars * BytesPerVar + 1023) DIV 1024,'KB Handle=',Hdl);
  272.   WriteLn('Total Extended Memory Available After Allocation: ',
  273.           XMSTotalMemoryAvailable, ' KB');
  274.  
  275.   { Fill the variables with 1 ... NumVars for exercise }
  276.   WriteLn('Filling Memory Block ');
  277.   FOR I := 1 TO NumVars DO
  278.     BEGIN
  279.       { parameters in Move Data are - Address of Data to Move
  280.                                     - Number of Bytes
  281.                                     - Memory Handle
  282.                                     - Offset in XMS Area }
  283.       IF NOT XMSMoveDataTo(@I, BytesPerVar, Hdl, (I - 1) *
  284.         BytesPerVar) THEN
  285.         WriteLn('Error on Move to XMS: ',I,' Error: ', XMSErrorCode);
  286.       IF I MOD 1024 = 0 THEN Write(I:6,^M);
  287.     END;
  288.   WriteLn;
  289.   { Now read a couple of locations just to show how}
  290.   I := 1;  { First Element }
  291.   IF NOT XMSGetDataFrom(Hdl, (I - 1) * BytesPerVar,
  292.     BytesPerVar, @Result) THEN
  293.     WriteLn('Error on XMSGetDataFrom')
  294.     ELSE WriteLn('XMS Data [',I,']=',Result); { Print it }
  295.   I := NumVars;  { Last Element }
  296.   IF NOT XMSGetDataFrom(Hdl, (I - 1) * BytesPerVar, BytesPerVar,
  297.     @Result) THEN
  298.     WriteLn('Error on XMSGetDataFrom')
  299.     ELSE WriteLn('XMS Data [',I,']=',Result); { Print it }
  300.  
  301.   WriteLn('Release status=', XMSReleaseBlock(Hdl));
  302.   WriteLn('Press a key.');
  303.   ReadKey;
  304. END.
  305.