home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / TP6XMS.ZIP / XMS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-03-03  |  14.2 KB  |  725 lines
  1. {---------------------------------------------------------------------------}
  2. {   eXtended Memory Specification Unit for Turbo Pascal 6.0 - Version 1.0   }
  3. { Written by Yuval Tal, 13 Glazer st, Rehovot 76283, Israel  Date: 4-Mar-91 }
  4. { BitNet: NYYUVAL@WEIZMANN        InterNet: NYYUVAL@WEIZMANN.WEIZMANN.AC.IL }
  5. {---------------------------------------------------------------------------}
  6. { This program may be freely distributed for non-commercial, non-business,  }
  7. { and non-governmental uses, provided this notice is attached with it.  My  }
  8. { only request is that if you plan to use it regularly, you let me know of  }
  9. { it through e-mail or postal mail, so that I have an idea of how useful    }
  10. { this program is (if you will add some cash to that letter it would be     }
  11. { nice, ofcourse :-)). Also, if you have any problems, suggestions etc'     }
  12. { please let me know. For more information read the document file.          }
  13. {---------------------------------------------------------------------------}
  14.  
  15. Unit XMS;
  16.  
  17. Interface
  18.  
  19. Var
  20.   Present: Boolean;                        {True if XMM driver is installed}
  21.   XMSError: Byte;                          {Error number. If 0 -> no error}
  22.  
  23. Function  XMMPresent: Boolean;
  24. Function  XMSErrorString(Error: Byte): String;
  25. Function  XMSMemAvail: Word;
  26. Function  XMSMaxAvail: Word;
  27. Function  GetXMMVersion: Word;
  28. Function  GetXMSVersion: Word;
  29. Procedure MoveFromEMB(Handle: Word; Var Dest; BlockLength: LongInt);
  30. Procedure MoveToEMB(Var Source; Handle: Word; BlockLength: LongInt);
  31. Function  EMBGetMem(Size: Word): Word;
  32. Procedure EMBFreeMem(Handle: Word);
  33. Procedure EMBResize(Handle, Size: Word);
  34. Function  GetAvailEMBHandles: Byte;
  35. Function  GetEMBLock(Handle: Word): Byte;
  36. Function  GetEMBSize(Handle: Word): Word;
  37. Function  LockEMB(Handle: Word): LongInt;
  38. Procedure UnlockEMB(Handle: Word);
  39. Function  UMBGetMem(Size: Word; Var Segment: Word): Word;
  40. Procedure UMBFreeMem(Segment: Word);
  41. Function  GetA20Status: Boolean;
  42. Procedure DisableLocalA20;
  43. Procedure EnableLocalA20;
  44. Procedure DisableGlobalA20;
  45. Procedure EnableGlobalA20;
  46. Procedure HMAGetMem(Size: Word);
  47. Procedure HMAFreeMem;
  48. Function  GetHMA: Boolean;
  49.  
  50. Implementation
  51.  
  52. Uses
  53.   Dos;
  54.  
  55. Const
  56.   High=1;
  57.   Low=2;
  58.   NumberOfErrors=27;
  59.   ErrorNumber: Array [1..NumberOfErrors] Of Byte = ($80,$81,$82,$8E,$8F,$90,
  60.                 $91,$92,$93,$94,$A0,$A1,$A2,$A3,$A4,$A5,$A6,$A7,$A8,$A9,$AA,
  61.                 $AB,$AC,$AD,$B0,$B1,$B2);
  62.   ErrorString: Array [0..NumberOfErrors] Of String = (
  63.                'Unknown error',
  64.                'Function no implemented',
  65.                'VDISK device driver was detected',
  66.                'A20 error occured',
  67.                'General driver errror',
  68.                'Unrecoverable driver error',
  69.                'High memory area does not exist',
  70.                'High memory area is already in use',
  71.                'DX is less than the ninimum of KB that program may use',
  72.                'High memory area not allocated',
  73.                'A20 line still enabled',
  74.                'All extended memory is allocated',
  75.                'Extended memory handles exhausted',
  76.                'Invalid handle',
  77.                'Invalid source handle',
  78.                'Invalid source offset',
  79.                'Invalid destination handle',
  80.                'Invalid destination offset',
  81.                'Invalid length',
  82.                'Invalid overlap in move request',
  83.                'Parity error detected',
  84.                'Block is not locked',
  85.                'Block is locked',
  86.                'Lock count overflowed',
  87.                'Lock failed',
  88.                'Smaller UMB is available',
  89.                'No UMBs are available',
  90.                'Inavlid UMB segment number');
  91.  
  92. Type
  93.   XMSParamBlock=
  94.     Record
  95.       Length: LongInt;
  96.       SHandle: Word;
  97.       SOffset: Array[High..Low] Of Word;
  98.       DHandle: Word;
  99.       DOffset: Array[High..Low] Of Word;
  100.     End;
  101.  
  102. Var
  103.   XMSAddr: Array[High..Low] Of Word;       {XMM driver address 1=Low,2=High}
  104.  
  105. {---------------------------------------------------------------------------}
  106.  
  107. Function XMMPresent: Boolean;
  108.  
  109. Var
  110.   Regs: Registers;
  111.  
  112. Begin
  113.   With Regs Do
  114.     Begin
  115.       AX:=$4300;
  116.       Intr($2F,Regs);
  117.       XMMPresent:=AL=$80;
  118.     End;
  119. End;
  120.  
  121. {---------------------------------------------------------------------------}
  122.  
  123. Function XMSErrorString(Error: Byte): String;
  124.  
  125. Var
  126.   I,Index: Byte;
  127.  
  128. Begin
  129.   Index:=0;
  130.   For I:=1 To NumberOfErrors Do
  131.     If ErrorNumber[I]=Error Then Index:=I;
  132.   XMSErrorString:=ErrorString[Index];
  133. End;
  134.  
  135. {---------------------------------------------------------------------------}
  136.  
  137. Function XMSMemAvail: Word;
  138.  
  139. Var
  140.   Memory: Word;
  141.  
  142. Begin
  143.   XMSError:=0;
  144.   If Not(Present) Then Exit;
  145.   Asm
  146.     Mov  AH,8
  147.     Call [XMSAddr]
  148.     Or   AX,AX
  149.     Jne  @@1
  150.     Mov  XMSError,BL
  151.     Jmp  @@2
  152. @@1:
  153.     Mov  Memory,DX
  154. @@2:
  155.   End;
  156.   XMSMemAvail:=Memory;
  157. End;
  158.  
  159. {---------------------------------------------------------------------------}
  160.  
  161. Function XMSMaxAvail: Word;
  162.  
  163. Var
  164.   Temp: Word;
  165.  
  166. Begin
  167.   XMSError:=0;
  168.   If Not(Present) Then Exit;
  169.   Asm
  170.     Mov  AH,8
  171.     Call [XMSAddr]
  172.     Or   AX,AX
  173.     Jne  @@1
  174.     Mov  XMSError,BL
  175.     Jmp  @@2
  176. @@1:
  177.     Mov  Temp,AX
  178. @@2:
  179.   End;
  180.   XMSMaxAvail:=Temp;
  181. End;
  182.  
  183. {---------------------------------------------------------------------------}
  184.  
  185. Function EMBGetMem(Size: Word): Word;
  186.  
  187. Var
  188.   Temp: Word;
  189.  
  190. Begin
  191.   XMSError:=0;
  192.   If Not(Present) Then Exit;
  193.   Asm
  194.     Mov  AH,9
  195.     Mov  DX,Size
  196.     Call [XMSAddr]
  197.     Or   AX,AX
  198.     Jne  @@1
  199.     Mov  XMSError,BL
  200.     Jmp  @@2
  201. @@1:
  202.     Mov  Temp,DX
  203. @@2:
  204.   End;
  205.   EMBGetMem:=Temp;
  206. End;
  207.  
  208. {---------------------------------------------------------------------------}
  209.  
  210. Procedure EMBFreeMem(Handle: Word);
  211.  
  212. Begin
  213.   XMSError:=0;
  214.   If Not(Present) Then Exit;
  215.   Asm
  216.     Mov  AH,0Ah
  217.     Mov  DX,Handle
  218.     Call [XMSAddr]
  219.     Or   AX,AX
  220.     Jne  @@1
  221.     Mov  XMSError,BL
  222. @@1:
  223.   End;
  224. End;
  225.  
  226. {---------------------------------------------------------------------------}
  227.  
  228. Procedure EMBResize(Handle, Size: Word);
  229.  
  230. Begin
  231.   XMSError:=0;
  232.   If Not(Present) Then Exit;
  233.   Asm
  234.     Mov  AH,0Fh
  235.     Mov  DX,Handle
  236.     Mov  BX,Size
  237.     Call [XMSAddr]
  238.     Or   AX,AX
  239.     Jne  @@1
  240.     Mov  XMSError,BL
  241. @@1:
  242.   End;
  243. End;
  244.  
  245. {---------------------------------------------------------------------------}
  246.  
  247. Procedure MoveToEMB(Var Source; Handle: Word; BlockLength: LongInt);
  248.  
  249. Var
  250.   ParamBlock: XMSParamBlock;
  251.   XSeg,PSeg,POfs: Word;
  252.  
  253. Begin
  254.   XMSError:=0;
  255.   If Not(Present) Then Exit;
  256.   With ParamBlock Do
  257.     Begin
  258.       Length:=BlockLength;
  259.       SHandle:=0;
  260.       SOffset[High]:=Ofs(Source);
  261.       SOffset[Low]:=Seg(Source);
  262.       DHandle:=Handle;
  263.       DOffset[High]:=0;
  264.       DOffset[Low]:=0;
  265.     End;
  266.   PSeg:=Seg(ParamBlock);
  267.   POfs:=Ofs(ParamBlock);
  268.   XSeg:=Seg(XMSAddr);
  269.  
  270.   Asm
  271.     Push DS
  272.     Mov  AH,0Bh
  273.     Mov  SI,POfs
  274.     Mov  BX,XSeg
  275.     Mov  ES,BX
  276.     Mov  BX,PSeg
  277.     Mov  DS,BX
  278.     Call [ES:XMSAddr]
  279.     Or   AX,AX
  280.     Jne  @@1
  281.     Mov  XMSError,BL
  282. @@1:
  283.     Pop  DS
  284.   End;
  285. End;
  286.  
  287. {---------------------------------------------------------------------------}
  288.  
  289. Procedure MoveFromEMB(Handle: Word; Var Dest; BlockLength: LongInt);
  290.  
  291. Var
  292.   ParamBlock: XMSParamBlock;
  293.   XSeg,PSeg,POfs: Word;
  294.  
  295. Begin
  296.   XMSError:=0;
  297.   If Not(Present) Then Exit;
  298.   With ParamBlock Do
  299.     Begin
  300.       Length:=BlockLength;
  301.       SHandle:=Handle;
  302.       SOffset[High]:=0;
  303.       SOffset[Low]:=0;
  304.       DHandle:=0;
  305.       DOffset[High]:=Ofs(Dest);
  306.       DOffset[Low]:=Seg(Dest);
  307.     End;
  308.   PSeg:=Seg(ParamBlock);
  309.   POfs:=Ofs(ParamBlock);
  310.   XSeg:=Seg(XMSAddr);
  311.  
  312.   Asm
  313.     Push DS
  314.     Mov  AH,0Bh
  315.     Mov  SI,POfs
  316.     Mov  BX,XSeg;
  317.     Mov  ES,BX
  318.     Mov  BX,PSeg
  319.     Mov  DS,BX
  320.     Call [ES:XMSAddr]
  321.     Or   AX,AX
  322.     Jne  @@1
  323.     Mov  XMSError,BL
  324. @@1:
  325.     Pop  DS
  326.   End;
  327. End;
  328.  
  329. {---------------------------------------------------------------------------}
  330.  
  331. Function GetXMSVersion: Word;
  332.  
  333. Var
  334.   HighB, LowB: Byte;
  335.  
  336. Begin
  337.   XMSError:=0;
  338.   If Not(Present) Then Exit;
  339.   Asm
  340.     Mov  AH,0
  341.     Call [XMSAddr]
  342.     Or   AX,AX
  343.     Jne  @@1
  344.     Mov  XMSError,BL
  345.     Jmp  @@2
  346. @@1:
  347.     Mov  HighB,AH
  348.     Mov  LowB,AL
  349. @@2:
  350.   End;
  351.   GetXMSVersion:=(HighB*100)+LowB;
  352. End;
  353.  
  354. {---------------------------------------------------------------------------}
  355.  
  356. Function GetXMMVersion: Word;
  357.  
  358. Var
  359.   HighB, LowB: Byte;
  360.  
  361. Begin
  362.   XMSError:=0;
  363.   If Not(Present) Then Exit;
  364.   Asm
  365.     Mov  AH,0
  366.     Call [XMSAddr]
  367.     Or   AX,AX
  368.     Jne  @@1
  369.     Mov  XMSError,BL
  370.     Jmp  @@2
  371. @@1:
  372.     Mov  HighB,BH
  373.     Mov  LowB,BL
  374. @@2:
  375.   End;
  376.   GetXMMVersion:=(HighB*100)+LowB;
  377. End;
  378.  
  379. {---------------------------------------------------------------------------}
  380.  
  381. Function GetHMA: Boolean;
  382.  
  383. Var
  384.   Temp: Boolean;
  385.  
  386. Begin
  387.   XMSError:=0;
  388.   If Not(Present) Then Exit;
  389.   Temp:=False;
  390.   Asm
  391.     Mov  AH,0
  392.     Call [XMSAddr]
  393.     Or   AX,AX
  394.     Jne  @@1
  395.     Mov  XMSError,BL
  396.     Jmp  @@2
  397. @@1:
  398.     Cmp  DX,0
  399.     Je   @@2
  400.     Mov  Temp,1
  401. @@2:
  402.   End;
  403.   GetHMA:=Temp;
  404. End;
  405.  
  406. {---------------------------------------------------------------------------}
  407.  
  408. Procedure HMAGetMem(Size: Word);
  409.  
  410. Begin
  411.   XMSError:=0;
  412.   If Not(Present) Then Exit;
  413.   Asm
  414.     Mov  AH,1
  415.     Mov  DX,Size
  416.     Call [XMSAddr]
  417.     Or   AX,AX
  418.     Jne  @@1
  419.     Mov  XMSError,BL
  420. @@1:
  421.   End;
  422. End;
  423.  
  424. {---------------------------------------------------------------------------}
  425.  
  426. Procedure HMAFreeMem;
  427.  
  428. Begin
  429.   XMSError:=0;
  430.   If Not(Present) Then Exit;
  431.   Asm
  432.     Mov  AH,2
  433.     Call [XMSAddr]
  434.     Or   AX,AX
  435.     Jne  @@1
  436.     Mov  XMSError,BL
  437. @@1:
  438.   End;
  439. End;
  440.  
  441. {---------------------------------------------------------------------------}
  442.  
  443. Procedure EnableGlobalA20;
  444.  
  445. Begin
  446.   XMSError:=0;
  447.   If Not(Present) Then Exit;
  448.   Asm
  449.     Mov  AH,3
  450.     Call [XMSAddr]
  451.     Or   AX,AX
  452.     Jne  @@1
  453.     Mov  XMSError,BL
  454. @@1:
  455.   End;
  456. End;
  457.  
  458.  
  459. {---------------------------------------------------------------------------}
  460.  
  461. Procedure DisableGlobalA20;
  462.  
  463. Begin
  464.   XMSError:=0;
  465.   If Not(Present) Then Exit;
  466.   Asm
  467.     Mov  AH,4
  468.     Call [XMSAddr]
  469.     Or   AX,AX
  470.     Jne  @@1
  471.     Mov  XMSError,BL
  472. @@1:
  473.   End;
  474. End;
  475.  
  476. {---------------------------------------------------------------------------}
  477.  
  478. Procedure EnableLocalA20;
  479.  
  480. Begin
  481.   XMSError:=0;
  482.   If Not(Present) Then Exit;
  483.   Asm
  484.     Mov  AH,5
  485.     Call [XMSAddr]
  486.     Or   AX,AX
  487.     Jne  @@1
  488.     Mov  XMSError,BL
  489. @@1:
  490.   End;
  491. End;
  492.  
  493. {---------------------------------------------------------------------------}
  494.  
  495. Procedure DisableLocalA20;
  496.  
  497. Begin
  498.   XMSError:=0;
  499.   If Not(Present) Then Exit;
  500.   Asm
  501.     Mov  AH,6
  502.     Call [XMSAddr]
  503.     Or   AX,AX
  504.     Jne  @@1
  505.     Mov  XMSError,BL
  506. @@1:
  507.   End;
  508. End;
  509.  
  510. {---------------------------------------------------------------------------}
  511.  
  512. Function GetA20Status: Boolean;
  513.  
  514. Var
  515.   Temp: Boolean;
  516.  
  517. Begin
  518.   XMSError:=0;
  519.   If Not(Present) Then Exit;
  520.   Temp:=True;
  521.   Asm
  522.     Mov  AH,6
  523.     Call [XMSAddr]
  524.     Or   AX,AX
  525.     Jne  @@1
  526.     Mov  XMSError,BL
  527.     Or   AX,AX
  528.     Jne  @@1
  529.     Or   BL,BL
  530.     Jne  @@2
  531.     Mov  Temp,0
  532.     Jmp  @@1
  533. @@2:
  534.     Mov  XMSError,BL
  535. @@1:
  536.   End;
  537. End;
  538.  
  539. {---------------------------------------------------------------------------}
  540.  
  541. Function LockEMB(Handle: Word): LongInt;
  542.  
  543. Var
  544.   Temp1,Temp2: Word;
  545.   Temp: LongInt;
  546.  
  547. Begin
  548.   XMSError:=0;
  549.   If Not(Present) Then Exit;
  550.   Asm
  551.     Mov  AH,0Ch
  552.     Mov  DX,Handle
  553.     Call [XMSAddr]
  554.     Or   AX,AX
  555.     Jne  @@1
  556.     Mov  XMSError,BL
  557.     Jmp  @@2
  558. @@1:
  559.     Mov  Temp1,DX
  560.     Mov  Temp2,BX
  561. @@2:
  562.   End;
  563.   Temp:=Temp1;
  564.   LockEMB:=(Temp Shl 4)+Temp2;
  565. End;
  566.  
  567. {---------------------------------------------------------------------------}
  568.  
  569. Procedure UnlockEMB(Handle: Word);
  570.  
  571. Begin
  572.   XMSError:=0;
  573.   If Not(Present) Then Exit;
  574.   Asm
  575.     Mov  AH,0Dh
  576.     Mov  DX,Handle
  577.     Call [XMSAddr]
  578.     Or   AX,AX
  579.     Jne  @@1
  580.     Mov  XMSError,BL
  581. @@1:
  582.   End;
  583. End;
  584.  
  585. {---------------------------------------------------------------------------}
  586.  
  587. Function GetEMBSize(Handle: Word): Word;
  588.  
  589. Var
  590.   Temp: Word;
  591.  
  592. Begin
  593.   XMSError:=0;
  594.   If Not(Present) Then Exit;
  595.   Asm
  596.     Mov  AH,0Eh
  597.     Mov  DX,Handle
  598.     Call [XMSAddr]
  599.     Or   AX,AX
  600.     Jne  @@1
  601.     Mov  XMSError,BL
  602.     Jmp  @@2
  603. @@1:
  604.     Mov  Temp,DX
  605. @@2:
  606.   End;
  607.   GetEMBSize:=Temp;
  608. End;
  609.  
  610. {---------------------------------------------------------------------------}
  611.  
  612. Function GetEMBLock(Handle: Word): Byte;
  613.  
  614. Var
  615.   Temp: Byte;
  616.  
  617. Begin
  618.   XMSError:=0;
  619.   If Not(Present) Then Exit;
  620.   Asm
  621.     Mov  AH,0Eh
  622.     Mov  DX,Handle
  623.     Call [XMSAddr]
  624.     Or   AX,AX
  625.     Jne  @@1
  626.     Mov  XMSError,BL
  627.     Jmp  @@2
  628. @@1:
  629.     Mov  Temp,BH
  630. @@2:
  631.   End;
  632.   GetEMBLock:=Temp;
  633. End;
  634.  
  635. {---------------------------------------------------------------------------}
  636.  
  637. Function GetAvailEMBHandles: Byte;
  638.  
  639. Var
  640.   Temp: Byte;
  641.  
  642. Begin
  643.   XMSError:=0;
  644.   If Not(Present) Then Exit;
  645.   Asm
  646.     Mov  AH,0Eh
  647.     Call [XMSAddr]
  648.     Or   AX,AX
  649.     Jne  @@1
  650.     Mov  XMSError,BL
  651.     Jmp  @@2
  652. @@1:
  653.     Mov  Temp,BL
  654. @@2:
  655.   End;
  656.   GetAvailEMBHandles:=Temp;
  657. End;
  658.  
  659. {---------------------------------------------------------------------------}
  660.  
  661. Function UMBGetMem(Size: Word; Var Segment: Word): Word; {Actual size}
  662.  
  663. Var
  664.   Temp1,Temp2: Word;
  665.  
  666. Begin
  667.   XMSError:=0;
  668.   If Not(Present) Then Exit;
  669.   Asm
  670.     Mov  AH,10h
  671.     Mov  DX,Size
  672.     Call [XMSAddr]
  673.     Or   AX,AX
  674.     Jne  @@1
  675.     Mov  XMSError,BL
  676.     Jmp  @@2
  677. @@1:
  678.     Mov  Temp2,BX
  679. @@2:
  680.     Mov  Temp1,DX
  681.   End;
  682.   Segment:=Temp2;
  683.   UMBGetMem:=Temp1;
  684. End;
  685.  
  686. {---------------------------------------------------------------------------}
  687.  
  688. Procedure UMBFreeMem(Segment: Word);
  689.  
  690. Begin
  691.   XMSError:=0;
  692.   If Not(Present) Then Exit;
  693.   Asm
  694.     Mov  AH,10h
  695.     Mov  DX,Segment
  696.     Call [XMSAddr]
  697.     Or   AX,AX
  698.     Jne  @@1
  699.     Mov  XMSError,BL
  700. @@1:
  701.   End;
  702. End;
  703.  
  704. {---------------------------------------------------------------------------}
  705.  
  706. Var
  707.   Regs: Registers;
  708.  
  709. Begin
  710.   If Not(XMMPresent) Then
  711.     Begin
  712.       WriteLn('XMS not supported!');
  713.       Present:=False;
  714.       Exit;
  715.     End;
  716.   Present:=True;
  717.   With Regs Do
  718.     Begin
  719.       AX:=$4310;
  720.       Intr($2F,Regs);
  721.       XMSAddr[High]:=BX;
  722.       XMSAddr[Low]:=ES;
  723.     End;
  724. End.
  725.