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

    {
    PETER BEEFTINK

    See below an XMS Unit I picked up somewhere.  I must admit that I have never
    been successful at using it, but maybe you have more luck.
    }

    Unit MegaXMS;

    Interface

    Var
      Present  : Boolean; {True if XMM driver is installed}
      XMSError : Byte;    {Error number. if 0 -> no error}

    Function  XMMPresent : Boolean;
    Function  XMSErrorString(Error : Byte) : String;
    Function  XMSMemAvail : Word;
    Function  XMSMaxAvail : Word;
    Function  GetXMMVersion : Word;
    Function  GetXMSVersion : Word;
    Procedure MoveFromEMB(Handle : Word; Var Dest; BlockLength : LongInt);
    Procedure MoveToEMB(Var Source; Handle : Word; BlockLength : LongInt);
    Function  EMBGetMem(Size : Word) : Word;
    Procedure EMBFreeMem(Handle : Word);
    Procedure EMBResize(Handle, Size : Word);
    Function  GetAvailEMBHandles : Byte;
    Function  GetEMBLock(Handle : Word) : Byte;
    Function  GetEMBSize(Handle : Word) : Word;
    Function  LockEMB(Handle : Word) : LongInt;
    Procedure UnlockEMB(Handle : Word);
    Function  UMBGetMem(Size : Word; Var Segment : Word) : Word;
    Procedure UMBFreeMem(Segment : Word);
    Function  GetA20Status : Boolean;
    Procedure DisableLocalA20;
    Procedure EnableLocalA20;
    Procedure DisableGlobalA20;
    Procedure EnableGlobalA20;
    Procedure HMAGetMem(Size : Word);
    Procedure HMAFreeMem;
    Function  GetHMA : Boolean;

    Implementation

    Uses
      Dos;

    Const
      High = 1;
      Low  = 2;
      NumberOfErrors = 27;

      ErrorNumber : Array [1..NumberOfErrors] Of Byte =
        ($80,$81,$82,$8E,$8F,$90,$91,$92,$93,$94,$A0,$A1,$A2,$A3,
         $A4,$A5,$A6,$A7,$A8,$A9,$AA,$AB,$AC,$AD,$B0,$B1,$B2);

      ErrorString : Array [0..NumberOfErrors] Of String = (
        'Unknown error',
        'Function no implemented',
        'VDISK device driver was detected',
        'A20 error occured',
        'General driver errror',
        'Unrecoverable driver error',
        'High memory area does not exist',
        'High memory area is already in use',
        'DX is less than the ninimum of KB that Program may use',
        'High memory area not allocated',
        'A20 line still enabled',
        'All extended memory is allocated',
        'Extended memory handles exhausted',
        'Invalid handle',
        'Invalid source handle',
        'Invalid source offset',
        'Invalid destination handle',
        'Invalid destination offset',
        'Invalid length',
        'Invalid overlap in move request',
        'Parity error detected',
        'Block is not locked',
        'Block is locked',
        'Lock count overflowed',
        'Lock failed',
        'Smaller UMB is available',
        'No UMBs are available',
        'Inavlid UMB segment number');

    Type
      XMSParamBlock= Record
        Length  : LongInt;
        SHandle : Word;
        SOffset : Array [High..Low] Of Word;
        DHandle : Word;
        DOffset : Array [High..Low] Of Word;
      end;

    Var
      XMSAddr : Array [High..Low] Of Word; {XMM driver address 1=Low,2=High}

    Function XMMPresent: Boolean;
    Var
      Regs : Registers;
    begin
      Regs.AX := $4300;
      Intr($2F, Regs);
      XMMPresent := Regs.AL = $80;
    end;

    Function XMSErrorString(Error : Byte) : String;
    Var
      I, Index : Byte;
    begin
      Index := 0;
      For I := 1 To NumberOfErrors Do
        if ErrorNumber[I] = Error Then
          Index := I;
      XMSErrorString := ErrorString[Index];
    end;

    Function XMSMemAvail : Word;
    Var
      Memory : Word;
    begin
      XMSError := 0;
      if Not(Present) Then
        Exit;
      Asm
        Mov  AH, 8
        Call [XMSAddr]
        Or   AX, AX
        Jne  @@1
        Mov  XMSError, BL
        Jmp  @@2
       @@1:
        Mov  Memory, DX
       @@2:
      end;
      XMSMemAvail := Memory;
    end;

    Function XMSMaxAvail : Word;
    Var
      Temp : Word;
    begin
      XMSError := 0;
      if Not(Present) Then
        Exit;
      Asm
        Mov  AH, 8
        Call [XMSAddr]
        Or   AX, AX
        Jne  @@1
        Mov  XMSError, BL
        Jmp  @@2
       @@1:
        Mov  Temp, AX
       @@2:
      end;
      XMSMaxAvail := Temp;
    end;

    Function EMBGetMem(Size : Word) : Word;
    Var
      Temp : Word;
    begin
      XMSError := 0;
      if Not(Present) Then
        Exit;
      Asm
        Mov  AH, 9
        Mov  DX, Size
        Call [XMSAddr]
        Or   AX, AX
        Jne  @@1
        Mov  XMSError, BL
        Jmp  @@2
       @@1:
        Mov  Temp, DX
       @@2:
      end;
      EMBGetMem := Temp;
    end;

    Procedure EMBFreeMem(Handle : Word);
    begin
      XMSError := 0;
      if Not(Present) Then
        Exit;
      Asm
        Mov  AH, 0Ah
        Mov  DX, Handle
        Call [XMSAddr]
        Or   AX, AX
        Jne  @@1
        Mov  XMSError, BL
       @@1:
      end;
    end;

    Procedure EMBResize(Handle, Size : Word);
    begin
      XMSError := 0;
      if Not(Present) Then
        Exit;
      Asm
        Mov  AH, 0Fh
        Mov  DX, Handle
        Mov  BX, Size
        Call [XMSAddr]
        Or   AX, AX
        Jne  @@1
        Mov  XMSError, BL
       @@1:
      end;
    end;

    Procedure MoveToEMB(Var Source; Handle : Word; BlockLength : LongInt);
    Var
      ParamBlock : XMSParamBlock;
      XSeg, PSeg,
      POfs       : Word;
    begin
      XMSError := 0;
      if Not(Present) Then
        Exit;
      With ParamBlock Do
      begin
        Length        := BlockLength;
        SHandle       := 0;
        SOffset[High] := Ofs(Source);
        SOffset[Low]  := Seg(Source);
        DHandle       := Handle;
        DOffset[High] := 0;
        DOffset[Low]  := 0;
      end;
      PSeg := Seg(ParamBlock);
      POfs := Ofs(ParamBlock);
      XSeg := Seg(XMSAddr);

      Asm
        Push DS
        Mov  AH, 0Bh
        Mov  SI, POfs
        Mov  BX, XSeg
        Mov  ES, BX
        Mov  BX, PSeg
        Mov  DS, BX
        Call [ES:XMSAddr]
        Or   AX, AX
        Jne  @@1
        Mov  XMSError, BL
       @@1:
        Pop  DS
      end;
    end;

    Procedure MoveFromEMB(Handle : Word; Var Dest; BlockLength : LongInt);
    Var
      ParamBlock : XMSParamBlock;
      XSeg, PSeg,
      POfs       : Word;
    begin
      XMSError := 0;
      if Not(Present) Then
        Exit;
      With ParamBlock Do
      begin
        Length        := BlockLength;
        SHandle       := Handle;
        SOffset[High] := 0;
        SOffset[Low]  := 0;
        DHandle       := 0;
        DOffset[High] := Ofs(Dest);
        DOffset[Low]  := Seg(Dest);
      end;
      PSeg := Seg(ParamBlock);
      POfs := Ofs(ParamBlock);
      XSeg := Seg(XMSAddr);

      Asm
        Push DS
        Mov  AH, 0Bh
        Mov  SI, POfs
        Mov  BX, XSeg;
        Mov  ES, BX
        Mov  BX, PSeg
        Mov  DS, BX
        Call [ES:XMSAddr]
        Or   AX, AX
        Jne  @@1
        Mov  XMSError, BL
       @@1:
        Pop  DS
      end;
    end;

    Function GetXMSVersion : Word;
    Var
      HighB, LowB : Byte;
    begin
      XMSError := 0;
      if Not(Present) Then
        Exit;
      Asm
        Mov  AH, 0
        Call [XMSAddr]
        Or   AX, AX
        Jne  @@1
        Mov  XMSError, BL
        Jmp  @@2
       @@1:
        Mov  HighB, AH
        Mov  LowB, AL
       @@2:
      end;
      GetXMSVersion := (HighB * 100) + LowB;
    end;

    Function GetXMMVersion : Word;
    Var
      HighB, LowB : Byte;
    begin
      XMSError := 0;
      if Not(Present) Then
        Exit;
      Asm
        Mov  AH, 0
        Call [XMSAddr]
        Or   AX, AX
        Jne  @@1
        Mov  XMSError, BL
        Jmp  @@2
       @@1:
        Mov  HighB, BH
        Mov  LowB, BL
       @@2:
      end;
      GetXMMVersion := (HighB * 100) + LowB;
    end;

    Function GetHMA : Boolean;
    Var
      Temp : Boolean;
    begin
      XMSError := 0;
      if Not(Present) Then
        Exit;
      Temp := False;
      Asm
        Mov  AH, 0
        Call [XMSAddr]
        Or   AX, AX
        Jne  @@1
        Mov  XMSError, BL
        Jmp  @@2
       @@1:
        Cmp  DX, 0
        Je   @@2
        Mov  Temp, 1
       @@2:
      end;
      GetHMA := Temp;
    end;

    Procedure HMAGetMem(Size : Word);
    begin
      XMSError := 0;
      if Not(Present) Then
        Exit;
      Asm
        Mov  AH, 1
        Mov  DX, Size
        Call [XMSAddr]
        Or   AX, AX
        Jne  @@1
        Mov  XMSError, BL
       @@1:
      end;
    end;

    Procedure HMAFreeMem;
    begin
      XMSError := 0;
      if Not(Present) Then
        Exit;
      Asm
        Mov  AH, 2
        Call [XMSAddr]
        Or   AX, AX
        Jne  @@1
        Mov  XMSError, BL
       @@1:
      end;
    end;

    Procedure EnableGlobalA20;
    begin
      XMSError := 0;
      if Not(Present) Then
        Exit;
      Asm
        Mov  AH, 3
        Call [XMSAddr]
        Or   AX, AX
        Jne  @@1
        Mov  XMSError, BL
       @@1:
      end;
    end;

    Procedure DisableGlobalA20;
    begin
      XMSError := 0;
      if Not(Present) Then
        Exit;
      Asm
        Mov  AH, 4
        Call [XMSAddr]
        Or   AX, AX
        Jne  @@1
        Mov  XMSError, BL
       @@1:
      end;
    end;

    Procedure EnableLocalA20;
    begin
      XMSError := 0;
      if Not(Present) Then Exit;
      Asm
        Mov  AH, 5
        Call [XMSAddr]
        Or   AX, AX
        Jne  @@1
        Mov  XMSError, BL
       @@1:
      end;
    end;

    Procedure DisableLocalA20;
    begin
      XMSError := 0;
      if Not(Present) Then
        Exit;
      Asm
        Mov  AH, 6
        Call [XMSAddr]
        Or   AX, AX
        Jne  @@1
        Mov  XMSError, BL
       @@1:
      end;
    end;

    Function GetA20Status : Boolean;
    Var
      Temp : Boolean;
    begin
      XMSError := 0;
      if Not(Present) Then
        Exit;
      Temp := True;
      Asm
        Mov  AH, 6
        Call [XMSAddr]
        Or   AX, AX
        Jne  @@1
        Mov  XMSError, BL
        Or   AX, AX
        Jne  @@1
        Or   BL, BL
        Jne  @@2
        Mov  Temp, 0
        Jmp  @@1
       @@2:
        Mov  XMSError, BL
       @@1:
      end;
    end;

    Function LockEMB(Handle : Word) : LongInt;
    Var
      Temp1,
      Temp2 : Word;
      Temp  : LongInt;
    begin
      XMSError := 0;
      if Not(Present) Then
        Exit;
      Asm
        Mov  AH, 0Ch
        Mov  DX, Handle
        Call [XMSAddr]
        Or   AX, AX
        Jne  @@1
        Mov  XMSError, BL
        Jmp  @@2
       @@1:
        Mov  Temp1, DX
        Mov  Temp2, BX
       @@2:
      end;
      Temp := Temp1;
      LockEMB := (Temp Shl 4) + Temp2;
    end;

    Procedure UnlockEMB(Handle : Word);
    begin
      XMSError := 0;
      if Not(Present) Then
        Exit;
      Asm
        Mov  AH, 0Dh
        Mov  DX, Handle
        Call [XMSAddr]
        Or   AX, AX
        Jne  @@1
        Mov  XMSError, BL
       @@1:
      end;
    end;

    Function GetEMBSize(Handle : Word) : Word;
    Var
      Temp : Word;
    begin
      XMSError := 0;
      if Not(Present) Then
        Exit;
      Asm
        Mov  AH, 0Eh
        Mov  DX, Handle
        Call [XMSAddr]
        Or   AX, AX
        Jne  @@1
        Mov  XMSError, BL
        Jmp  @@2
       @@1:
        Mov  Temp, DX
       @@2:
      end;
      GetEMBSize := Temp;
    end;

    Function GetEMBLock(Handle : Word) : Byte;
    Var
      Temp : Byte;
    begin
      XMSError := 0;
      if Not(Present) Then
        Exit;
      Asm
        Mov  AH, 0Eh
        Mov  DX, Handle
        Call [XMSAddr]
        Or   AX, AX
        Jne  @@1
        Mov  XMSError, BL
        Jmp  @@2
       @@1:
        Mov  Temp, BH
       @@2:
      end;
      GetEMBLock := Temp;
    end;

    Function GetAvailEMBHandles : Byte;
    Var
      Temp : Byte;
    begin
      XMSError := 0;
      if Not(Present) Then
        Exit;
      Asm
        Mov  AH, 0Eh
        Call [XMSAddr]
        Or   AX, AX
        Jne  @@1
        Mov  XMSError, BL
        Jmp  @@2
       @@1:
        Mov  Temp, BL
       @@2:
      end;
      GetAvailEMBHandles := Temp;
    end;

    Function UMBGetMem(Size : Word; Var Segment : Word) : Word; {Actual size}
    Var
      Temp1, Temp2 : Word;
    begin
      XMSError := 0;
      if Not(Present) Then
        Exit;
      Asm
        Mov  AH, 10h
        Mov  DX, Size
        Call [XMSAddr]
        Or   AX, AX
        Jne  @@1
        Mov  XMSError, BL
        Jmp  @@2
       @@1:
        Mov  Temp2, BX
       @@2:
        Mov  Temp1, DX
      end;
      Segment := Temp2;
      UMBGetMem := Temp1;
    end;

    Procedure UMBFreeMem(Segment : Word);
    begin
      XMSError := 0;
      if Not(Present) Then
        Exit;
      Asm
        Mov  AH, 10h
        Mov  DX, Segment
        Call [XMSAddr]
        Or   AX, AX
        Jne  @@1
        Mov  XMSError, BL
       @@1:
      end;
    end;

    Var
      Regs : Registers;
    begin
      if Not(XMMPresent) Then
      begin
        WriteLn('XMS not supported!');
        Present := False;
        Exit;
      end;
      Present := True;
      With Regs Do
      begin
        AX := $4310;
        Intr($2F, Regs);
        XMSAddr[High] := BX;
        XMSAddr[Low]  := ES;
      end;
    end.

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