home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / memory.swg / 0029_XMS Unit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-08-27  |  6.2 KB  |  233 lines
  1. {
  2. Sean Palmer
  3.  
  4. > I did not mean to imply that I expected a library that could provide
  5. > access to XMS With simple Pointer dereferences.  I understand the
  6. > difficulty of accessing >1MB from a Real-mode Program.  I would be
  7. > happy(ECSTATIC in fact) if I could find a library that would allow an
  8. > allocation to XMS, returning a handle to the block, and allow
  9. > access(copying) of the block via a Procedure call.  Of course, the
  10. > catch is that the library would have to be able to deal With random
  11. > allocations and deallocations-like a heap manager For XMS.  I know that
  12. > there are VMM's out there that can do this-I just can't get my hands
  13. > on one!
  14.  
  15. Try this:
  16.  
  17. turbo pascal 6.0 source
  18. }
  19.  
  20. Unit xms;  {this Unit won't handle blocks bigger than 64k}
  21.  
  22. Interface
  23.  
  24. Function  installed : Boolean;
  25. Function  init(Var h : Word; z : Word) : Boolean;   {alloc xms}
  26. Procedure avail(Var total, largest : Word);  {how much free?}
  27. Function  save(h, z : Word; Var s) : Boolean; {move main to xms}
  28. Function  load(h, z : Word; Var s) : Boolean; {move xms to main}
  29. Procedure free(h : Word);                     {dispose xms}
  30. Function  lock(h : Word) : LongInt;
  31. Function  unlock(h : Word) : Boolean;
  32. Function  getInfo(h : Word; Var lockCount, handlesLeft : Byte;
  33.                   Var sizeK : Word) : Boolean;
  34. Function  resize(h, sizeK : Word) : Boolean;
  35.  
  36. Implementation
  37.  
  38. {Error codes, returned in BL reg}
  39.  
  40. Const
  41.   FuncNotImplemented   = $80;          {Function is not implemented}
  42.   VDiskDeviceDetected  = $81;          {a VDISK compatible device found}
  43.   A20Error             = $82;          {an A20 error occurred}
  44.   GeneralDriverError   = $8E;          {general driver error}
  45.   UnrecoverableError   = $8F;          {unrecoverable driver error}
  46.   HmaDoesNotExist      = $90;          {high memory area does not exist}
  47.   HmaAlreadyInUse      = $91;          {high memory area already in use}
  48.   HmaSizeTooSmall      = $92;          {size requested less than /HMAMIN}
  49.   HmaNotAllocated      = $93;          {high memory area not allocated}
  50.   A20StillEnabled      = $94;          {A20 line is still enabled}
  51.   AllExtMemAllocated   = $A0;          {all extended memory is allocated}
  52.   OutOfExtMemHandles   = $A1;          {extended memory handles exhausted}
  53.   InvalidHandle        = $A2;          {invalid handle}
  54.   InvalidSourceHandle  = $A3;          {invalid source handle}
  55.   InvalidSourceOffset  = $A4;          {invalid source offset}
  56.   InvalidDestHandle    = $A5;          {invalid destination handle}
  57.   InvalidDestOffset    = $A6;          {invalid destination offset}
  58.   InvalidLength        = $A7;          {invalid length}
  59.   OverlapInMoveReq     = $A8;          {overlap in move request}
  60.   ParityErrorDetected  = $A9;          {parity error detected}
  61.   BlockIsNotLocked     = $AA;          {block is not locked}
  62.   BlockIsLocked        = $AB;          {block is locked}
  63.   LockCountOverflowed  = $AC;          {lock count overflowed}
  64.   LockFailed           = $AD;          {lock failed}
  65.   SmallerUMBAvailable  = $B0;          {a smaller upper memory block is avail}
  66.   NoUMBAvailable       = $B1;          {no upper memory blocks are available}
  67.   InvalidUMBSegment    = $B2;          {invalid upper memory block segment}
  68.  
  69.   xmsProc : Pointer = nil; {entry point For xms driver, nil if none}
  70.  
  71. Var
  72.   copyRec : Record
  73.     size : LongInt;    {Bytes to move (must be even)}
  74.     srcH : Word;       {handle (0=conventional mem)}
  75.     srcP : Pointer;
  76.     dstH : Word;
  77.     dstP : Pointer;
  78.   end;
  79.  
  80.  
  81. Function installed : Boolean;
  82. begin
  83.   installed := (xmsProc <> nil);
  84. end;
  85.  
  86. Function init(Var h : Word; z : Word) : Boolean; Assembler;
  87. Asm
  88.   mov  dx, z
  89.   test dx, $3FF
  90.   jz   @S
  91.   add  dx, $400
  92.  @S: {allow For partial K's}
  93.   mov  cl, 10
  94.   shr  dx, cl  {convert to K}
  95.   mov  ah, 9
  96.   call xmsProc {allocate XMS block}
  97.   cmp  ax, 1
  98.   je   @S2
  99.   xor  al, al
  100.  @S2:
  101.   les  di, h
  102.   mov  es:[di], dx
  103. end;
  104.  
  105. Procedure avail(Var total, largest : Word); Assembler;
  106. Asm
  107.   mov  ah, 8
  108.   call xmsProc  {query free xms}
  109.   les  di, total
  110.   mov  es:[di], dx
  111.   les  di, largest
  112.   mov  es:[di], ax
  113. end;
  114.  
  115. Function copy : Boolean; Assembler;
  116. Asm  {internal}
  117.   push ds
  118.   mov  si, offset copyRec {it's in DS, right?}
  119.   mov  ah, $B
  120.   call xmsProc  {copy memory}
  121.   cmp  ax,1
  122.   je   @S
  123.   xor  al,al
  124.  @S:
  125.   pop  ds
  126. end;
  127.  
  128. Function save(h, z : Word; Var s) : Boolean;
  129. begin
  130.   if odd(z) then
  131.     inc(z);
  132.   With copyRec do
  133.   begin
  134.     size := z;
  135.     srcH := 0;
  136.     srcP := @s; {source, from main memory}
  137.     dstH := h;
  138.     dstP := ptr(0,0); {dest, to xms block}
  139.   end;
  140.   save := copy;
  141. end;
  142.  
  143. Function load(h, z : Word; Var s) : Boolean;
  144. begin
  145.   if odd(z) then
  146.     inc(z);
  147.   With copyRec do
  148.   begin
  149.     size := z;
  150.     srcH := h;
  151.     srcP := ptr(0,0); {source, from xms block}
  152.     dstH := 0;
  153.     dstP := @s; {dest, to main memory}
  154.   end;
  155.   load := copy;
  156. end;
  157.  
  158. Procedure free(h : Word); Assembler;
  159. Asm
  160.   mov  dx, h
  161.   mov  ah, $A
  162.   call xmsProc
  163. end;
  164.  
  165. Function lock(h : Word) : LongInt; Assembler;
  166. Asm
  167.   mov  ah, $C
  168.   mov  dx, h
  169.   call xmsProc {lock xms block}
  170.   cmp  ax, 1
  171.   je   @OK
  172.   xor  bx, bx
  173.   xor  dx, dx
  174.  @OK:  {set block to nil (0) if err}
  175.   mov  ax, bx
  176. end;
  177.  
  178. Function unlock(h : Word) : Boolean; Assembler;
  179. Asm
  180.   mov  ah, $D
  181.   mov  dx, h
  182.   call xmsProc {unlock xms block}
  183.   cmp  ax, 1
  184.   je   @S
  185.   xor  al, al
  186.  @S:
  187. end;
  188.  
  189. Function getInfo(h : Word; Var lockCount, handlesLeft : Byte;
  190.                  Var sizeK : Word) : Boolean; Assembler;
  191. Asm
  192.   mov  ah, $E
  193.   mov  dx, h
  194.   call xmsProc  {get xms handle info}
  195.   cmp  ax, 1
  196.   je   @S
  197.   xor  al, al
  198.  @S:
  199.   les  di, lockCount
  200.   mov  es:[di], bh
  201.   les  di, handlesLeft
  202.   mov  es:[di], bl
  203.   les  di, sizeK
  204.   mov  es:[di], dx
  205. end;
  206.  
  207. Function resize(h, sizeK : Word) : Boolean; Assembler;
  208. Asm
  209.   mov  ah, $F
  210.   mov  dx, h
  211.   mov  bx, sizeK
  212.   call xmsProc {resize XMS block}
  213.   cmp  ax ,1
  214.   je   @S
  215.   xor  al, al
  216.  @S:
  217. end;
  218.  
  219. begin
  220.   Asm {there is a possibility these ints will trash the ds register}
  221.     mov ax, $4300 {load check Function For xms driver}
  222.     int $2F  {call multiplex int}
  223.     cmp al, $80
  224.     jne @X
  225.     mov ax, $4310
  226.     int $2F {get adr of entry point->es:bx}
  227.     mov Word ptr xmsProc, bx
  228.     mov Word ptr xmsProc+2, es
  229.    @X:
  230.   end;
  231. end.
  232.  
  233.