home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-385-Vol-1of3.iso / o / opxms.zip / OPXMS.PAS < prev    next >
Pascal/Delphi Source File  |  1992-09-25  |  32KB  |  844 lines

  1. {$S-,R-,V-,I-,B-,F-,O-,A-}
  2.  
  3. {$I OPDEFINE.INC}
  4.  
  5. {*********************************************************}
  6. {*                   OPXMS.PAS 1.20                      *}
  7. {*       Copyright (c) TurboPower Software 1987, 1989.   *}
  8. {*                 All rights reserved.                  *}
  9. {*********************************************************}
  10.  
  11. unit OpXms;
  12.   {-XMS memory management routines}
  13.  
  14. interface
  15.  
  16. type
  17.   {pointers in XMS are segm:ofs for < 1 meg, and linear for > 1 meg}
  18.   ExtMemPtr      =
  19.     record
  20.       case Boolean of
  21.         False : (RealPtr : Pointer);
  22.         True  : (ProtectedPtr : LongInt);
  23.     end;
  24.  
  25.   {the record structure used internally by MoveExtMemBlock}
  26.   ExtMemMoveStruct =
  27.     record
  28.       Len        : LongInt;
  29.       SrcHand    : Word;
  30.       SrcOffs    : ExtMemPtr;
  31.       DestHand   : Word;
  32.       DestOffs   : ExtMemPtr;
  33.     end;
  34.  
  35. var
  36.   XmsControl       : Pointer;          {ptr to XMS control procedure}
  37.  
  38. const
  39.   FuncNotImplemented   = $80;          {function is not implemented}
  40.   VDiskDeviceDetected  = $81;          {a VDISK compatible device found}
  41.   A20Error             = $82;          {an A20 error occurred}
  42.   GeneralDriverError   = $8E;          {general driver error}
  43.   UnrecoverableError   = $8F;          {unrecoverable driver error}
  44.   HmaDoesNotExist      = $90;          {high memory area does not exist}
  45.   HmaAlreadyInUse      = $91;          {high memory area already in use}
  46.   HmaSizeTooSmall      = $92;          {size requested less than /HMAMIN}
  47.   HmaNotAllocated      = $93;          {high memory area not allocated}
  48.   A20StillEnabled      = $94;          {A20 line is still enabled}
  49.   AllExtMemAllocated   = $A0;          {all extended memory is allocated}
  50.   OutOfExtMemHandles   = $A1;          {extended memory handles exhausted}
  51.   InvalidHandle        = $A2;          {invalid handle}
  52.   InvalidSourceHandle  = $A3;          {invalid source handle}
  53.   InvalidSourceOffset  = $A4;          {invalid source offset}
  54.   InvalidDestHandle    = $A5;          {invalid destination handle}
  55.   InvalidDestOffset    = $A6;          {invalid destination offset}
  56.   InvalidLength        = $A7;          {invalid length}
  57.   OverlapInMoveReq     = $A8;          {overlap in move request}
  58.   ParityErrorDetected  = $A9;          {parity error detected}
  59.   BlockIsNotLocked     = $AA;          {block is not locked}
  60.   BlockIsLocked        = $AB;          {block is locked}
  61.   LockCountOverflowed  = $AC;          {lock count overflowed}
  62.   LockFailed           = $AD;          {lock failed}
  63.   SmallerUMBAvailable  = $B0;          {a smaller upper memory block is avail}
  64.   NoUMBAvailable       = $B1;          {no upper memory blocks are available}
  65.   InvalidUMBSegment    = $B2;          {invalid upper memory block segment}
  66.  
  67. function XmsInstalled : Boolean;
  68.   {-Returns True if an XMS memory manager is installed}
  69.  
  70. function RequestHMA(Bytes : Word) : Byte;
  71.   {-Request the High Memory Area (HMA). Bytes is amount of memory if TSR or
  72.     device driver, or $FFFF if application program.
  73.  
  74.     Possible return codes:
  75.       $00 successful
  76.       $80 if the function is not implemented
  77.       $81 if a VDISK device is detected
  78.       $90 if the HMA does not exist
  79.       $91 if the HMA is already in use
  80.       $92 if Bytes is less than the /HMAMIN= parameter
  81.   }
  82.  
  83. function ReleaseHMA : Byte;
  84.   {-Release the High Memory Area.
  85.  
  86.     Possible return codes:
  87.       $00 successful
  88.       $80 if the function is not implemented
  89.       $81 if a VDISK device is detected
  90.       $90 if the HMA does not exist
  91.       $93 if the HMA was not allocated
  92.   }
  93.  
  94. function GlobalEnableA20 : Byte;
  95.   {-Attempt to enable the A20 line. Should be used only by programs that
  96.     have control of the HMA.
  97.  
  98.     Possible return codes:
  99.       $00 successful
  100.       $80 if the function is not implemented
  101.       $81 if a VDISK device is detected
  102.       $82 if an A20 error occurs
  103.   }
  104.  
  105. function GlobalDisableA20 : Byte;
  106.   {-Attempt to enable the A20 line. Should be used only by programs that
  107.     have control of the HMA.
  108.  
  109.     Possible return codes:
  110.       $00 successful
  111.       $80 if the function is not implemented
  112.       $81 if a VDISK device is detected
  113.       $82 if an A20 error occurs
  114.       $94 if the A20 line is still enabled
  115.   }
  116.  
  117. function LocalEnableA20 : Byte;
  118.   {-Attempt to enable the A20 line. Should be used only by programs that
  119.     need direct access to extended memory.
  120.  
  121.     Possible return codes:
  122.       $00 successful
  123.       $80 if the function is not implemented
  124.       $81 if a VDISK device is detected
  125.       $82 if an A20 error occurs
  126.   }
  127.  
  128. function LocalDisableA20 : Byte;
  129.   {-Attempt to enable the A20 line. Should be used only by programs that
  130.     need direct access to extended memory.
  131.  
  132.     Possible return codes:
  133.       $00 successful
  134.       $80 if the function is not implemented
  135.       $81 if a VDISK device is detected
  136.       $82 if an A20 error occurs
  137.       $94 if the A20 line is still enabled
  138.   }
  139.  
  140. function QueryA20 : Byte;
  141.   {-Checks to see if the A20 line is physically enabled.
  142.  
  143.     Possible return codes:
  144.       $00 A20 line disabled
  145.       $01 A20 line enabled
  146.       $80 if the function is not implemented
  147.       $81 if a VDISK device is detected
  148.   }
  149.  
  150. function QueryFreeExtMem(var TotalFree, LargestBlock : Word) : Byte;
  151.   {-Return the amount of total free extended memory in TotalFree, and the Size
  152.     of the largest free block of extended memory in LargestBlock. Both values
  153.     are specified in number of kilobytes.
  154.  
  155.     Possible function results:
  156.       $00 successful
  157.       $80 if the function is not implemented
  158.       $81 if a VDISK device is detected
  159.       $A0 if all extended memory is allocated
  160.   }
  161.  
  162. function AllocateExtMem(SizeInK : Word; var XmsHandle : Word) : Byte;
  163.   {-Allocate a block of extended memory SizeInK kilobytes in Size, returning
  164.     the XMS handle in XmsHandle.
  165.  
  166.     Possible function results:
  167.       $00 successful
  168.       $80 if the function is not implemented
  169.       $81 if a VDISK device is detected
  170.       $A0 if all extended memory is allocated
  171.       $A1 if all extended memory handles are in use
  172.   }
  173.  
  174. function FreeExtMem(XmsHandle : Word) : Byte;
  175.   {-Free a previously allocated block of extended memory. XmsHandle is the XMS
  176.     handle returned by the previous call to AllocateExtMem.
  177.  
  178.     Possible function results:
  179.       $00 successful
  180.       $80 if the function is not implemented
  181.       $81 if a VDISK device is detected
  182.       $A2 if XmsHandle is invalid
  183.       $AB if XmsHandle is currently locked
  184.   }
  185. function MoveExtMemBlock(BlockLength : LongInt;
  186.                          SourceHandle : Word;
  187.                          SourcePtr : ExtMemPtr;
  188.                          DestHandle : Word;
  189.                          DestPtr : ExtMemPtr) : Byte;
  190.   {-Move a block of memory. Intended primarily for moving data to and from
  191.     extended memory and conventional memory. Can also move memory from
  192.     extended to extended and conventional to conventional. BlockLength must
  193.     always be an even number. Memory areas may overlap ONLY if SourcePtr is at
  194.     a lower address than DestPtr. If SourceHandle is 0, then SourcePtr is
  195.     interpreted as a normal segment:offset dword pointer. If SourceHandle is
  196.     non-zero, then the SourcePtr is interpreted as a 32 bit linear offset into
  197.     the extended memory associated with SourceHandle. The same is true for
  198.     DestHandle and DestPtr. This routine does NOT require that the A20 be
  199.     enabled. Extended memory blocks used as SourcePtr or DestPtr need not be
  200.     locked before calling this routine (although they may be locked).
  201.  
  202.     Possible function results:
  203.       $00 successful
  204.       $80 if the function is not implemented
  205.       $81 if a VDISK device is detected
  206.       $82 if an A20 error occurs
  207.       $A3 if SourceHandle is invalid
  208.       $A4 if SourcePtr is invalid
  209.       $A5 if DestHandle is invalid
  210.       $A6 if DestPtr is invalid
  211.       $A7 if BlockLen is invalid
  212.       $A8 if SourcePtr and DestPtr contain an invalid overlap
  213.       $A9 if a memory parity error occurs
  214.   }
  215.  
  216. function LockExtMemBlock(XmsHandle : Word;
  217.                          var LockedBlock : ExtMemPtr) : Byte;
  218.   {-Locks an extended memory block and returns its base address as a 32 bit
  219.     linear address. Locked extended memory blocks are guaranteed not to move.
  220.     The LockedBlock address is valid only while the block is locked. Locked
  221.     extended memory blocks should be unlocked as quickly as possible. It is
  222.     not necessary to lock a block before calling MoveExtMemBlock. A count of
  223.     the number of locks is maintained by the XMS memory manager and can be
  224.     retrieved with the GetHandleInfo function.
  225.  
  226.     Possible function results:
  227.       $00 successful
  228.       $80 if the function is not implemented
  229.       $81 if a VDISK device is detected
  230.       $A2 if XmsHandle is invalid
  231.       $AC if the block's lock count overflows
  232.       $AD if the lock fails
  233.   }
  234.  
  235. function UnlockExtMemBlock(XmsHandle : Word) : Byte;
  236.   {-Unlocks an extended memory block. Any 32 bit linear addresses in use
  237.     obtained by calling LockExtMemBlock are invalid after UnlockExtMemBlock is
  238.     called.
  239.  
  240.     Possible function results:
  241.       $00 successful
  242.       $80 if the function is not implemented
  243.       $81 if a VDISK device is detected
  244.       $A2 if XmsHandle is invalid
  245.       $AC if the block's lock count overflows
  246.       $AA if the block is not locked
  247.   }
  248.  
  249. function GetHandleInfo(XmsHandle : Word;
  250.                        var LockCount    : Byte;
  251.                        var HandlesLeft  : Byte;
  252.                        var BlockSizeInK : Word) : Byte;
  253.   {-Return information about an extended memory handle. The lock count for
  254.     this handle, the number of XMS handles left, and the Size in kilobytes of
  255.     this handle are returned. To retrieve the 32 bit linear address of this
  256.     handle, you must call LockExtMemBlock.
  257.  
  258.   Possible function results:
  259.       $00 successful
  260.       $80 if the function is not implemented
  261.       $81 if a VDISK device is detected
  262.       $A2 if XmsHandle is invalid
  263.   }
  264.  
  265. function ResizeExtMemBlock(XmsHandle : Word; NewSizeInK : Word) : Byte;
  266.   {-Attempts to resize the memory block associated with XmsHandle. The
  267.     extended memory block must be unlocked. If the NewSizeInK is bigger than
  268.     the previous Size, then all data is preserved. If it is smaller, then all
  269.     data beyond the end of the new block Size is lost.
  270.  
  271.   Possible function results:
  272.       $00 successful
  273.       $80 if the function is not implemented
  274.       $81 if a VDISK device is detected
  275.       $A0 if all extended memory is allocated
  276.       $A1 if all extended memory handles are in use
  277.       $A2 if XmsHandle is invalid
  278.       $AB if the block is locked
  279.   }
  280.  
  281. function AllocUpperMemBlock(SizeInParas : Word;
  282.                             var SegmentBase : Word;
  283.                             var Size        : Word) : Byte;
  284.   {-Allocates an upper memory block (UMB). If insufficient memory is available
  285.     in upper memory blocks, then the Size of the largest free upper memory
  286.     block is returned in Size. If this functions succeeds, then SegmentBase
  287.     contains the segment of the allocated upper memory block. Upper memory
  288.     blocks are paragraphed aligned (the offset is always 0).
  289.  
  290.     By definition, UMBs are located below the 1 meg address boundary.
  291.     Therefore the A20 line need not be enabled to access the memory in a UMB.
  292.     Therefore there are no restrictions on using this memory in DOS calls or
  293.     pointing ISRs into this memory.
  294.  
  295.     This function is not implemented by most 286 XMS drivers. It is
  296.     implemented by most 386 products like QEMM and 386^MAX.
  297.  
  298.   Possible function results:
  299.       $00 successful
  300.       $80 if the function is not implemented
  301.       $B0 if a smaller UMB is available
  302.       $B1 if no UMBs are available
  303.   }
  304.  
  305. function FreeUpperMemBlock(SegmentBase : Word) : Byte;
  306.   {-Frees a previously allocated upper memory block.
  307.  
  308.   Possible function results:
  309.       $00 successful
  310.       $80 if the function is not implemented
  311.       $82 if SegmentBase does not refer to a valid UMB
  312.   }
  313.  
  314. function XmsErrorString(ErrorCode : Byte) : String;
  315.   {-Return a string indicating reason for error}
  316.  
  317.   {==========================================================================}
  318.  
  319. implementation
  320.  
  321.   function XmsInstalledPrim : Boolean;
  322.     {-Returns True if an XMS memory manager is installed}
  323.   inline(
  324.     $B8/$00/$43/     {   MOV     AX,$4300           ; XMS Installed function}
  325.     $CD/$2F/         {   INT     $2F                ; DOS Multiplex int}
  326.     $3C/$80/         {   CMP     AL,$80             ; is it there?}
  327.     $75/$04/         {   JNE     NoXmsDriver}
  328.     $B0/$01/         {   MOV     AL,1               ; return True}
  329.     $EB/$02/         {   JMP     SHORT XIExit}
  330.                      {NoXmsDriver:}
  331.     $30/$C0);        {   XOR     AL,AL              ; return False}
  332.                      {XIExit:}
  333.  
  334.   function XmsInstalled : Boolean;
  335.     {-Returns True if an XMS memory manager is installed}
  336.   begin
  337.     XmsInstalled := XmsControl <> Nil;
  338.   end;
  339.  
  340.   function RequestHMAPrim(Bytes : Word) : Byte;
  341.   inline(
  342.     $5A/                   {  POP      DX      ; get Bytes}
  343.     $B4/$01/               {  MOV      AH,1    ; XMS function 1 - Request HMA}
  344.     $FF/$1E/>XmsControl/   {  CALL     DWORD PTR [>XmsControl]}
  345.     $09/$C0/               {  OR       AX,AX}
  346.     $74/$04/               {  JZ       Error}
  347.     $30/$C0/               {  XOR      AL,AL}
  348.     $EB/$02/               {  JMP      SHORT ExitPoint}
  349.                            {Error:}
  350.     $88/$D8);              {  MOV      AL,BL}
  351.                            {ExitPoint:}
  352.  
  353.   function RequestHMA(Bytes : Word) : Byte;
  354.     {-Request the High Memory Area (HMA). Bytes is amount of memory if TSR or
  355.       device driver, or $FFFF if application program.
  356.  
  357.       Possible return codes:
  358.         $00 successful
  359.         $80 if the function is not implemented
  360.         $81 if a VDISK device is detected
  361.         $90 if the HMA does not exist
  362.         $91 if the HMA is already in use
  363.         $92 if Bytes is less than the /HMAMIN= parameter
  364.     }
  365.   begin
  366.     RequestHMA := RequestHMAPrim(Bytes)
  367.   end;
  368.  
  369.   function ReleaseHMAPrim : Byte;
  370.   inline(
  371.     $B4/$02/               {  MOV      AH,2    ; XMS function 2 - Release HMA}
  372.     $FF/$1E/>XmsControl/   {  CALL     DWORD PTR [>XmsControl]}
  373.     $09/$C0/               {  OR       AX,AX}
  374.     $74/$04/               {  JZ       Error}
  375.     $30/$C0/               {  XOR      AL,AL}
  376.     $EB/$02/               {  JMP      SHORT ExitPoint}
  377.                            {Error:}
  378.     $88/$D8);              {  MOV      AL,BL}
  379.                            {ExitPoint:}
  380.  
  381.   function ReleaseHMA : Byte;
  382.     {-Release the High Memory Area.
  383.  
  384.       Possible return codes:
  385.         $00 successful
  386.         $80 if the function is not implemented
  387.         $81 if a VDISK device is detected
  388.         $90 if the HMA does not exist
  389.         $93 if the HMA was not allocated
  390.     }
  391.   begin
  392.     ReleaseHMA := ReleaseHMAPrim;
  393.   end;
  394.  
  395.   function GlobalEnableA20Prim : Byte;
  396.   inline(
  397.     $B4/$03/               {  MOV AH,3      ; XMS function 3 - Global Enable A20}
  398.     $FF/$1E/>XmsControl/   {  CALL     DWORD PTR [>XmsControl]}
  399.     $09/$C0/               {  OR       AX,AX}
  400.     $74/$04/               {  JZ       Error}
  401.     $30/$C0/               {  XOR      AL,AL}
  402.     $EB/$02/               {  JMP      SHORT ExitPoint}
  403.                            {Error:}
  404.     $88/$D8);              {  MOV      AL,BL}
  405.                            {ExitPoint:}
  406.  
  407.   function GlobalEnableA20 : Byte;
  408.     {-Attempt to enable the A20 line. Should be used only by programs that
  409.       have control of the HMA.
  410.  
  411.       Possible return codes:
  412.         $00 successful
  413.         $80 if the function is not implemented
  414.         $81 if a VDISK device is detected
  415.         $82 if an A20 error occurs
  416.     }
  417.   begin
  418.     GlobalEnableA20 := GlobalEnableA20Prim;
  419.   end;
  420.  
  421.   function GlobalDisableA20Prim : Byte;
  422.   inline(
  423.     $B4/$04/               {  MOV AH,4      ; XMS function 4 - Global Disable A20}
  424.     $FF/$1E/>XmsControl/   {  CALL     DWORD PTR [>XmsControl]}
  425.     $09/$C0/               {  OR       AX,AX}
  426.     $74/$04/               {  JZ       Error}
  427.     $30/$C0/               {  XOR      AL,AL}
  428.     $EB/$02/               {  JMP      SHORT ExitPoint}
  429.                            {Error:}
  430.     $88/$D8);              {  MOV      AL,BL}
  431.                            {ExitPoint:}
  432.  
  433.   function GlobalDisableA20 : Byte;
  434.     {-Attempt to enable the A20 line. Should be used only by programs that
  435.       have control of the HMA.
  436.  
  437.       Possible return codes:
  438.         $00 successful
  439.         $80 if the function is not implemented
  440.         $81 if a VDISK device is detected
  441.         $82 if an A20 error occurs
  442.         $94 if the A20 line is still enabled
  443.     }
  444.   begin
  445.     GlobalDisableA20 := GlobalDisableA20Prim;
  446.   end;
  447.  
  448.   function LocalEnableA20Prim : Byte;
  449.   inline(
  450.     $B4/$05/               {  MOV AH,5      ; XMS function 3 - Local Enable A20}
  451.     $FF/$1E/>XmsControl/   {  CALL     DWORD PTR [>XmsControl]}
  452.     $09/$C0/               {  OR       AX,AX}
  453.     $74/$04/               {  JZ       Error}
  454.     $30/$C0/               {  XOR      AL,AL}
  455.     $EB/$02/               {  JMP      SHORT ExitPoint}
  456.                            {Error:}
  457.     $88/$D8);              {  MOV      AL,BL}
  458.                            {ExitPoint:}
  459.  
  460.   function LocalEnableA20 : Byte;
  461.     {-Attempt to enable the A20 line. Should be used only by programs that
  462.       need direct access to extended memory.
  463.  
  464.       Possible return codes:
  465.         $00 successful
  466.         $80 if the function is not implemented
  467.         $81 if a VDISK device is detected
  468.         $82 if an A20 error occurs
  469.     }
  470.   begin
  471.     LocalEnableA20 := LocalEnableA20Prim;
  472.   end;
  473.  
  474.   function LocalDisableA20Prim : Byte;
  475.   inline(
  476.     $B4/$06/               { MOV AH,6 ;XMS function 6 - Local Disable A20 !!.03}
  477.     $FF/$1E/>XmsControl/   {  CALL     DWORD PTR [>XmsControl]}
  478.     $09/$C0/               {  OR       AX,AX}
  479.     $74/$04/               {  JZ       Error}
  480.     $30/$C0/               {  XOR      AL,AL}
  481.     $EB/$02/               {  JMP      SHORT ExitPoint}
  482.                            {Error:}
  483.     $88/$D8);              {  MOV      AL,BL}
  484.                            {ExitPoint:}
  485.  
  486.   function LocalDisableA20 : Byte;
  487.     {-Attempt to enable the A20 line. Should be used only by programs that
  488.       need direct access to extended memory.
  489.  
  490.       Possible return codes:
  491.         $00 successful
  492.         $80 if the function is not implemented
  493.         $81 if a VDISK device is detected
  494.         $82 if an A20 error occurs
  495.         $94 if the A20 line is still enabled
  496.     }
  497.   begin
  498.     LocalDisableA20 := LocalDisableA20Prim;
  499.   end;
  500.  
  501.   function QueryA20Prim : Byte;
  502.   inline(
  503.     $B4/$07/               {  MOV      AH,7 ; XMS Function 7 - Query A20 !!.03}
  504.     $FF/$1E/>XmsControl/   {  CALL     DWORD PTR [>XmsControl]}
  505.     $08/$DB/               {  OR       BL,BL}
  506.     $74/$02/               {  JZ       ExitPoint}
  507.     $88/$D8);              {  MOV      AL,BL}
  508.                            {ExitPoint:}
  509.  
  510.   function QueryA20 : Byte;
  511.     {-Checks to see if the A20 line is physically enabled.
  512.  
  513.       Possible return codes:
  514.         $00 A20 line disabled
  515.         $01 A20 line enabled
  516.         $80 if the function is not implemented
  517.         $81 if a VDISK device is detected
  518.     }
  519.   begin
  520.     QueryA20 := QueryA20Prim;
  521.   end;
  522.  
  523.   function QueryFreeExtMem(var TotalFree, LargestBlock : Word) : Byte;
  524.   var
  525.     ErrorCode : Byte;
  526.   begin
  527.     inline(
  528.       $B4/$08/               {  MOV    AH,$08   ;XMS function 08h - Query Free ext memory}
  529.       $FF/$1E/>XmsControl/   {  CALL   DWORD PTR [>XmsControl]}
  530.       $09/$C0/               {  OR     AX,AX}
  531.       $74/$10/               {  JZ     SetError}
  532.       $30/$DB/               {  XOR    BL,BL}
  533.       $C4/$BE/>TotalFree/    {  LES    DI,>TotalFree[BP]}
  534.       $26/                   {ES:}
  535.       $89/$15/               {  MOV    [DI],DX}
  536.       $C4/$BE/>LargestBlock/ {  LES    DI,>LargestBlock[BP]}
  537.       $26/                   {ES:}
  538.       $89/$05/               {  MOV    [DI],AX}
  539.                              {SetError:}
  540.       $88/$5E/<ErrorCode);   {  MOV    <ErrorCode[BP],BL}
  541.     QueryFreeExtMem := ErrorCode;
  542.   end;
  543.  
  544.   function AllocateExtMem(SizeInK : Word; var XmsHandle : Word) : Byte;
  545.   var
  546.     ErrorCode : Byte;
  547.   begin
  548.     inline(
  549.       $B4/$09/               {  MOV    AH,$09   ;XMS function 09h - Alloc ext memory block}
  550.       $8B/$96/>SizeInK/      {  MOV    DX,>SizeInK[BP]}
  551.       $FF/$1E/>XmsControl/   {  CALL   DWORD PTR [>XmsControl]}
  552.       $A9/$01/$00/           {  TEST   AX,1}
  553.       $74/$09/               {  JZ     SetError}
  554.       $30/$DB/               {  XOR    BL,BL}
  555.       $C4/$BE/>XmsHandle/    {  LES    DI,>XmsHandle[BP]}
  556.       $26/                   {ES:}
  557.       $89/$15/               {  MOV    [DI],DX  ;return XMS handle}
  558.                              {SetError:}
  559.       $88/$5E/<ErrorCode);   {  MOV    <ErrorCode[BP],BL}
  560.     AllocateExtMem := ErrorCode;
  561.   end;
  562.  
  563.   function FreeExtMem(XmsHandle : Word) : Byte;
  564.   var
  565.     ErrorCode : Byte;
  566.   begin
  567.     inline(
  568.       $B4/$0A/               {  MOV    AH,$0A   ;XMS function 0Ah - Free ext memory block}
  569.       $8B/$96/>XmsHandle/    {  MOV    DX,>XmsHandle[BP]}
  570.       $FF/$1E/>XmsControl/   {  CALL   DWORD PTR [>XmsControl]}
  571.       $A9/$01/$00/           {  TEST   AX,1}
  572.       $74/$02/               {  JZ     SetError}
  573.       $30/$DB/               {  XOR    BL,BL}
  574.                              {SetError:}
  575.       $88/$5E/<ErrorCode);   {  MOV    <ErrorCode[BP],BL}
  576.     FreeExtMem := ErrorCode;
  577.   end;
  578.  
  579.   function MoveExtMemBlockPrim(ParamBlock : Pointer) : Byte;
  580.     {-Call XMS function $0B to move extended memory}
  581.   inline(
  582.     $8C/$D8/               {  MOV    AX,DS}
  583.     $8E/$C0/               {  MOV    ES,AX}
  584.     $5E/                   {  POP    SI}
  585.     $1F/                   {  POP    DS}
  586.     $50/                   {  PUSH   AX}
  587.     $B4/$0B/               {  MOV    AH,$0B   ;XMS function 0Bh - Move Extended}
  588.     $26/                   {ES:}
  589.     $FF/$1E/>XmsControl/   {  CALL   DWORD PTR [>XmsControl]}
  590.     $1F/                   {  POP    DS}
  591.     $A9/$01/$00/           {  TEST   AX,1}
  592.     $75/$04/               {  JNZ    Success}
  593.     $88/$D8/               {  MOV    AL,BL}
  594.     $EB/$02/               {  JMP    SHORT ExitPoint}
  595.                            {Success:}
  596.     $30/$C0);              {  XOR    AL,AL}
  597.                            {ExitPoint:}
  598.  
  599.  
  600.   function MoveExtMemBlock(BlockLength : LongInt;
  601.                            SourceHandle : Word;
  602.                            SourcePtr : ExtMemPtr;
  603.                            DestHandle : Word;
  604.                            DestPtr : ExtMemPtr) : Byte;
  605.   var
  606.     ControlBlock : ExtMemMoveStruct;
  607.   begin
  608.     with ControlBlock do begin
  609.       Len := BlockLength;
  610.       SrcHand   := SourceHandle;
  611.       SrcOffs   := SourcePtr;
  612.       DestHand  := DestHandle;
  613.       DestOffs  := DestPtr;
  614.       MoveExtMemBlock := MoveExtMemBlockPrim(@ControlBlock);
  615.     end;
  616.   end;
  617.  
  618.   function LockExtMemBlock(XmsHandle : Word;
  619.                            var LockedBlock : ExtMemPtr) : Byte;
  620.   var
  621.     ErrorCode : Byte;
  622.   begin
  623.     inline(
  624.       $B4/$0C/               {  MOV    AH,$0C   ;XMS function 0Ch - Lock ext memory block}
  625.       $8B/$96/>XmsHandle/    {  MOV    DX,>XmsHandle[BP]}
  626.       $FF/$1E/>XmsControl/   {  CALL   DWORD PTR [>XmsControl]}
  627.       $A9/$01/$00/           {  TEST   AX,1}
  628.       $74/$0D/               {  JZ     SetError}
  629.       $C4/$BE/>LockedBlock/  {  LES    DI,>LockedBlock[BP]}
  630.       $26/                   {ES:}
  631.       $89/$1D/               {  MOV    [DI],BX}
  632.       $26/                   {ES:}
  633.       $89/$55/$02/           {  MOV    [DI+2],DX}
  634.       $30/$DB/               {  XOR    BL,BL}
  635.                              {SetError:}
  636.       $88/$5E/<ErrorCode);   {  MOV    <ErrorCode[BP],BL}
  637.     LockExtMemBlock := ErrorCode;
  638.   end;
  639.  
  640.   function UnlockExtMemBlock(XmsHandle : Word) : Byte;
  641.   var
  642.     ErrorCode : Byte;
  643.   begin
  644.     inline(
  645.       $B4/$0D/               {  MOV    AH,$0D   ;XMS function 0Dh - Unlock ext memory block}
  646.       $8B/$96/>XmsHandle/    {  MOV    DX,>XmsHandle[BP]}
  647.       $FF/$1E/>XmsControl/   {  CALL   DWORD PTR [>XmsControl]}
  648.       $A9/$01/$00/           {  TEST   AX,1}
  649.       $74/$02/               {  JZ     SetError}
  650.       $30/$DB/               {  XOR    BL,BL}
  651.                              {SetError:}
  652.       $88/$5E/<ErrorCode);   {  MOV    <ErrorCode[BP],BL}
  653.     UnlockExtMemBlock := ErrorCode;
  654.   end;
  655.  
  656.   function GetHandleInfo(XmsHandle : Word;
  657.                          var LockCount    : Byte;
  658.                          var HandlesLeft  : Byte;
  659.                          var BlockSizeInK : Word) : Byte;
  660.   var
  661.     ErrorCode : Byte;
  662.   begin
  663.     inline(
  664.       $B4/$0E/               {  MOV    AH,$0E   ;XMS function 0Eh - Get EMB Handle Info}
  665.       $8B/$96/>XmsHandle/    {  MOV    DX,>XmsHandle[BP]}
  666.       $FF/$1E/>XmsControl/   {  CALL   DWORD PTR [>XmsControl]}
  667.       $A9/$01/$00/           {  TEST   AX,1}
  668.       $74/$17/               {  JZ     SetError}
  669.       $C4/$BE/>LockCount/    {  LES    DI,>LockCount[BP]}
  670.       $26/                   {ES:}
  671.       $88/$3D/               {  MOV    BYTE PTR [DI],BH}
  672.       $C4/$BE/>HandlesLeft/  {  LES    DI,>HandlesLeft[BP]}
  673.       $26/                   {ES:}
  674.       $88/$1D/               {  MOV    BYTE PTR [DI],BL}
  675.       $C4/$BE/>BlockSizeInK/ {  LES    DI,>BlockSizeInK[BP]}
  676.       $26/                   {ES:}
  677.       $89/$15/               {  MOV    [DI],DX}
  678.       $30/$DB/               {  XOR    BL,BL}
  679.                              {SetError:}
  680.       $88/$5E/<ErrorCode);   {  MOV    <ErrorCode[BP],BL}
  681.     GetHandleInfo := ErrorCode;
  682.   end;
  683.  
  684.   function ResizeExtMemBlock(XmsHandle : Word; NewSizeInK : Word) : Byte;
  685.   var
  686.     ErrorCode : Byte;
  687.   begin
  688.     inline(
  689.       $B4/$0F/               {  MOV    AH,$0F   ;XMS function 0Fh - Resize Ext mem block}
  690.       $8B/$96/>XmsHandle/    {  MOV    DX,>XmsHandle[BP]}
  691.       $8B/$9E/>NewSizeInK/   {  MOV    BX,>NewSizeInK[BP]}
  692.       $FF/$1E/>XmsControl/   {  CALL   DWORD PTR [>XmsControl]}
  693.       $A9/$01/$00/           {  TEST   AX,1}
  694.       $74/$02/               {  JZ     SetError}
  695.       $30/$DB/               {  XOR    BL,BL}
  696.                              {SetError:}
  697.       $88/$5E/<ErrorCode);   {  MOV    <ErrorCode[BP],BL}
  698.     ResizeExtMemBlock := ErrorCode;
  699.   end;
  700.  
  701.   function AllocUpperMemBlock(SizeInParas : Word;
  702.                               var SegmentBase : Word;
  703.                               var Size        : Word) : Byte;
  704.   var
  705.     ErrorCode : Byte;
  706.   begin
  707.     inline(
  708.       $B4/$10/               {  MOV    AH,$10   ;XMS function 10h - Alloc UMB}
  709.       $8B/$96/>SizeInParas/  {  MOV    DX,>SizeInParas[BP]}
  710.       $FF/$1E/>XmsControl/   {  CALL   DWORD PTR [>XmsControl]}
  711.       $A9/$01/$00/           {  TEST   AX,1}
  712.       $74/$12/               {  JZ     Error}
  713.       $C4/$BE/>Size/         {  LES    DI,>Size[BP]}
  714.       $26/                   {ES:}
  715.       $89/$15/               {  MOV    [DI],DX        ;return actual Size}
  716.       $C4/$BE/>SegmentBase/  {  LES    DI,>SegmentBase[BP]}
  717.       $26/                   {ES:}
  718.       $89/$1D/               {  MOV    [DI],BX        ;return segment base}
  719.       $30/$DB/               {  XOR    BL,BL}
  720.       $EB/$07/               {  JMP    SHORT SetError}
  721.                              {Error:}
  722.       $C4/$BE/>Size/         {  LES    DI,>Size[BP]}
  723.       $26/                   {ES:}
  724.       $89/$15/               {  MOV    [DI],DX        ;return largest avail block}
  725.                              {SetError:}
  726.       $88/$5E/<ErrorCode);   {  MOV    <ErrorCode[BP],BL}
  727.     AllocUpperMemBlock := ErrorCode;
  728.   end;
  729.  
  730.   function FreeUpperMemBlock(SegmentBase : Word) : Byte;
  731.   var
  732.     ErrorCode : Byte;
  733.   begin
  734.     inline(
  735.       $B4/$11/               {  MOV    AH,$11   ;XMS function 11h - Free UMB}
  736.       $8B/$96/>SegmentBase/  {  MOV    DX,>SegmentBase[BP]}
  737.       $FF/$1E/>XmsControl/   {  CALL   DWORD PTR [>XmsControl]}
  738.       $A9/$01/$00/           {  TEST   AX,1}
  739.       $74/$02/               {  JZ     SetError}
  740.       $30/$DB/               {  XOR    BL,BL}
  741.                              {SetError:}
  742.       $88/$5E/<ErrorCode);   {  MOV    <ErrorCode[BP],BL}
  743.     FreeUpperMemBlock := ErrorCode;
  744.   end;
  745.  
  746.   function HexB(B : Byte) : string;
  747.     {-Return hex string for byte}
  748.   const
  749.     Digits : array[0..$F] of Char = '0123456789ABCDEF';
  750.   begin
  751.     HexB[0] := #2;
  752.     HexB[1] := Digits[B shr 4];
  753.     HexB[2] := Digits[B and $F];
  754.   end;
  755.  
  756.   function XmsErrorString(ErrorCode : Byte) : String;
  757.     {-Return a string indicating reason for error}
  758.   begin
  759.     case ErrorCode of
  760.       $00 :
  761.         XmsErrorString := 'no XMS error';
  762.       FuncNotImplemented :
  763.         XmsErrorString := 'function not implemented';
  764.       VDiskDeviceDetected :
  765.         XmsErrorString := 'VDISK compatible device detected';
  766.       A20Error :
  767.         XmsErrorString := 'an A20 error occurred';
  768.       GeneralDriverError :
  769.         XmsErrorString := 'general driver error';
  770.       UnrecoverableError :
  771.         XmsErrorString := 'unrecoverable driver error';
  772.       HmaDoesNotExist :
  773.         XmsErrorString := 'high memory area does not exist';
  774.       HmaAlreadyInUse :
  775.         XmsErrorString := 'high memory area already in use';
  776.       HmaSizeTooSmall :
  777.         XmsErrorString := 'size requested less than /HMAMIN= parameter';
  778.       HmaNotAllocated :
  779.         XmsErrorString := 'high memory area not allocated';
  780.       A20StillEnabled :
  781.         XmsErrorString := 'A20 line is still enabled';
  782.       AllExtMemAllocated :
  783.         XmsErrorString := 'all extended memory is allocated';
  784.       OutOfExtMemHandles :
  785.         XmsErrorString := 'extended memory handles exhausted';
  786.       InvalidHandle :
  787.         XmsErrorString := 'invalid handle';
  788.       InvalidSourceHandle :
  789.         XmsErrorString := 'invalid source handle';
  790.       InvalidSourceOffset :
  791.         XmsErrorString := 'invalid source offset';
  792.       InvalidDestHandle :
  793.         XmsErrorString := 'invalid destination handle';
  794.       InvalidDestOffset :
  795.         XmsErrorString := 'invalid destination offset';
  796.       InvalidLength :
  797.         XmsErrorString := 'invalid length';
  798.       OverlapInMoveReq :
  799.         XmsErrorString := 'overlap in move request';
  800.       ParityErrorDetected :
  801.         XmsErrorString := 'parity error detected';
  802.       BlockIsNotLocked :
  803.         XmsErrorString := 'block is not locked';
  804.       BlockIsLocked :
  805.         XmsErrorString := 'block is locked';
  806.       LockCountOverflowed :
  807.         XmsErrorString := 'lock count overflowed';
  808.       LockFailed :
  809.         XmsErrorString := 'lock failed';
  810.       SmallerUMBAvailable :
  811.         XmsErrorString := 'a smaller upper memory block is available';
  812.       NoUMBAvailable :
  813.         XmsErrorString := 'no upper memory blocks are available';
  814.       InvalidUMBSegment :
  815.         XmsErrorString := 'invalid upper memory block segment';
  816.       else
  817.         XmsErrorString := 'unknown XMS error = $' + HexB(ErrorCode);
  818.     end;
  819.   end;
  820.  
  821.   function XmsControlAddr : Pointer;
  822.     {-Return address of XMS control function}
  823.   inline(
  824.     $B8/$10/$43/     {MOV     AX,$4310           ; XMS control func addr}
  825.     $CD/$2F/         {INT     $2F}
  826.     $89/$D8/         {MOV     AX,BX              ; ptr in ES:BX to DX:AX}
  827.     $8C/$C2);        {MOV     DX,ES}
  828.  
  829.   function DosVersion : Word;                    {added !!.12}
  830.     inline(
  831.       $B4/$30/                 {mov ah,$30}
  832.       $CD/$21);                {int $21}
  833.  
  834. begin
  835.   if Lo(DosVersion) >= 3 then begin               {!!.12}
  836.     if XmsInstalledPrim then
  837.       XmsControl := XmsControlAddr
  838.     else
  839.       XmsControl := Nil;
  840.   end
  841.   else                                            {!!.12}
  842.     XmsControl := Nil;                            {!!.12}
  843. end.
  844.