PC Underground/UNDERGROUND.ISO/memory/xms/memory.pas

Pascal/Delphi Source File | 1995-07-28 | 15.3 KB | 621 lines

Unit Memory;
{
  **************************************************************************
  ***   Memory - Unit  of  PC Underground by  DATA BECKER/ABACUS         ***
  ***   Author      : Boris Bertelsons                                   ***
  ***   Created     : 01/26/94                                           ***
  ***   Last update : 03/18/94                                           ***
  *** ------------------------------------------------------------------ ***
  ***  The unit provides routines for dealing with memory.               ***
  ***  In particular, this unit contains routines for handling           ***
  ***  XMS and EMS !                                                     ***
  **************************************************************************
}

Interface

uses dos;

TYPE XMSHandle = word;

     EMSHandle = word;

     XMS_Copyblock = Record     { required for the copy routines }
       Size     : longint;
       Q_Handle : Word;
       Q_Offset : pointer;
       Z_Handle : Word;
       Z_Offset : pointer;
     end;

     EMS_Header = Record        { for recognition of EMS }
       dummy   : array[0..9] of byte;
       ID : array[1..7] of char;
     end;

VAR XMS_Available   : boolean;  { TRUE, if XMS is available }
    XMST            : pointer;  { Driver - Entry point address }
    XMS_Version     : word;     { Version of XMS driver }
    XC              : XMS_Copyblock;
    EMS_Available   : boolean;  { TRUE, if  EMS is available }
    EMS_Version     : word;     { Number of EMS version. Vers.MAJ
                                              is in the Hi-Byte and VERS.MIN is in the
                                  Lo-Byte ! }
    EMS_Pages_Free : word;     { Number of free EMS pages }
    EMS_Pages_Tot : word;      { Total number of EMS pages
                                  available }


function  base_free : longint;
{
  The function returns the size of the maximum total of available
  main memory in bytes
}

function  XMS_free  : longint;
{
  The function returns the size of the maximum total of available
  XMS memory in bytes
}

Function Getmem_XMS(VAR H : XMSHandle; Size : longint) : byte;
{
 The function allocates a block in XMS that is Size Bytes large. Size
 is rounded off to the nearest kilobyte limit. The number of the handle
 by which the block can be addressed is returned in H and cannot be
 lost, because otherwise the block can only be addressed by a reset. If
 the function was able to allocate the memory, it returns the value 0,
 otherwise the error table shown in the book applies.
}

Function Freemem_XMS(H : XMSHandle) : byte;
{
 The function frees up a memory area in XMS that was allocated by GETMEM_XMS.
 The meaning of the function result can be found in the XMS error table.
}

Function XMS_2_XMS(h1,h2 : XMSHandle; Size : Word) : byte;
{
 This function copies the number of bytes passed in Size in XMS from h1 to h2.
 Size must be an EVEN value. The meaning of the function result can be
 found in the XMS error table.
}

Function RAM_2_XMS(q : pointer; h : XMSHandle; Size : Word) : byte;
{
 This function copies data from RAM to XMS. q is a pointer to the
 source data in RAM. h is the handle that you got from the GETMEM_XMS
 function. Size is the size of the block to be copied in bytes. Here again, Size
 is rounded off to the nearest kilobyte and you can check the XMS error table
 for the meaning of the function result.
}

Function XMS_2_Ram(d : pointer; h : XMSHandle; Size : Word) : byte;
{
 This function copies data from XMS to RAM. d is a pointer to the
 destination in RAM. h is the handle that you got from the GETMEM_XMS
 function. Size is the size of the block to be copied in bytes. Once again,
 Size is rounded off to the nearest kilobyte and you can check the XMS
 error table for the meaning of the function result.
}

Procedure Check_for_XMS;
{
 The procedure checks whether XMS is available, and initializes the
 variables required by the unit. XMS_Available is set to TRUE when an
 XMS driver is available. You will find the version number of the driver
 in XMS_Version.
}

procedure Check_for_EMS;
{
 This procedure checks whether EMS is available and initializes
 the corresponding variables
}

Function EMS_free  : longint;
{
 The function returns the size of the free EMS memory in bytes.
}

Function EMS_Segment_determine(VAR Segment : word) : byte;
{
 This function determines the segment where EMS starts being
 overlaid into RAM.
}

Function EMS_Get_PageNumber : byte;
{
 This function determines the total number of available pages in EMS
 as well as how many pages are still free. The values are placed in
 the global variables "EMS_Pages_Tot" and "EMS_Pages_Free".
}

Function Getmem_EMS(VAR H : EMSHandle; Size : longint) : byte;
{
 This function allocates the specified amount of memory in EMS. The
 memory can be addressed via the "H" handle. Please keep in mind
 that the function allocates at least one page, that is, 16K in EMS.
 That means that you should only page larger data structures
 in EMS.
}

Function Freemem_EMS(H : EMSHandle) : byte;
{
 This function frees up memory allocated by Getmem_EMS.
}

Function EMS_Allocation(H : EMSHandle;PagePage,EMSPage : word) : byte;
{
 Use this function to determine the allocation of EMS pages for the
 corresponding handle. PagePage can hold a value from 0 to 3, and
 stands for the page position at whic it is overlaid in RAM. EMSPage
 is the page in EMS that is to be overlaid. Thus, if you want to assign
 page 7 of EMS to the EMSH handle (important for blocks > 64K !),
 you need to call the function with the parameters (EMSH,0,7).
}

Function EMS_Protect_Allocation(H : EMSHandle) : byte;
{
 This function protects the order of the EMS page set by EMS_Allocation
 for the specified handle from changes.
}

Function EMS_Unprotect_Allocation(H : EMSHandle) : byte;
{
 A handle protected by EMS_Protect_Allocation must first be unprotected
 with this function before the allocation can be changed.
}

Function RAM_2_EMS(q : pointer; H : EMSHandle; Size : longint) : byte;
{
 Use this function to copy the specified block from RAM to EMS. Size
 refers to the size in bytes, q stands for a pointer to the source area and
 H is the handle from Getmem_EMS.
}

Function EMS_2_RAM(q : pointer; H : EMSHandle; Size : longint) : byte;
{
 Similar to RAM_2_EMS, this function copies a memory area from
 RAM to EMS.
}

Function EMS_Handles_assign(Var Number : word) : byte;
{
 This function gives you the number of EMS handles that  have already
 been assigned. A maximum of 256 handles can be assigned.
}

function XMS_lock(H : XMSHandle) : longint;
{
 The function locks an XMS block from being moved and returns
 its absolute address
}

procedure XMS_unlock(H : XMSHandle);
{
 The procedure unlocks an XMS handle that has been locked from
 being moved.
}


implementation

function base_free : longint;
begin;
  base_free := MemAvail;
end;

function XMS_free  : longint;
var xms_in_kb : word;
    xms_long: longint;
begin;
  asm
    mov ax,0800h                { 8 = Get free memory }
    call dword ptr [XMST]
    mov xms_in_kb,dx
  end;
  xms_long := xms_in_kb;
  XMS_free := xms_long * 1024;
end;

Function Getmem_XMS(VAR H : XMSHandle; Size : longint) : byte;
var bsize : word;
    Fresult : byte;
    xmsh : word;
begin;
  bsize := (size DIV 1024) + 1;
  asm
    mov ax,0900h                { 9 = allocate memory area }
    mov dx,bsize
    call dword ptr [XMST]
    cmp ax,1
    jne @Error_GetmemXms
    mov xmsh,dx
    mov Fresult,0
    jmp @End_GetmemXms
@Error_GetmemXMS:
    mov Fresult,bl
@End_GetmemXms:
  end;
  h := xmsh;
  Getmem_Xms := Fresult;
end;

Function Freemem_XMS(H : XMSHandle) : byte;
var fresult : byte;
begin;
  asm                           { A = deallocate memory area }
    mov ax,0a00h
    mov dx,h
    call dword ptr [XMST]
    cmp ax,1
    jne @Error_FreememXms
    mov Fresult,0
    jmp @End_FreememXms
@Error_FreememXms:
    mov Fresult,bl
@End_FreememXms:
  end;
end;

Function XMS_2_XMS(h1,h2 : XMSHandle; Size : Word) : byte;
VAR fresult : byte;
begin;
  XC.Size     := Size;          { size of block in bytes }
  XC.Q_Handle := h1;            { source handle }
  XC.Q_Offset := nil;           { source offset, 0 = start of block }
  XC.Z_Handle := h2;            { destination handle }
  XC.Z_Offset := nil;           { destination offset }
  asm
    mov si,offset XC
    mov ax,0B00h
    call dword ptr [XMST]
    cmp ax,1
    jne @Error_RAM2XMS
    mov fresult,0
    jmp @End_Ram2XMS
@Error_Ram2XMS:
    mov fresult,bl
@End_Ram2XMS:
  end;
end;

Function RAM_2_XMS(q : pointer; h : XMSHandle; Size : Word) : byte;
VAR fresult : byte;
begin;
  XC.Size     := Size;
  XC.Q_Handle := 0;               { 0 = RAM }
  XC.Q_Offset := q;
  XC.Z_Handle := h;
  XC.Z_Offset := nil;
  asm
    mov si,offset XC
    mov ax,0B00h
    call dword ptr [XMST]
    cmp ax,1
    jne @Error_RAM2XMS
    mov fresult,0
    jmp @End_Ram2XMS
@Error_Ram2XMS:
    mov fresult,bl
@End_Ram2XMS:
  end;
end;

Function XMS_2_Ram(d : pointer; h : XMSHandle; Size : Word) : byte;
VAR fresult : byte;
begin;
  XC.Size     := Size;
  XC.Q_Handle := h;
  XC.Q_Offset := nil;
  XC.Z_Handle := 0;               { 0 = RAM }
  XC.Z_Offset := d;
  asm
    mov si,offset XC
    mov ax,0B00h
    call dword ptr [XMST]
    cmp ax,1
    jne @Error_XMS2RAM
    mov fresult,0
    jmp @End_XMS2Ram
@Error_XMS2Ram:
    mov fresult,bl
@End_XMS2Ram:
  end;
end;

Procedure Check_for_XMS; assembler;
  asm
    mov ax,4300h              { check whether driver installed }
    int 2Fh
    cmp al,80h
    jne @No_XMSdriver
    mov ax,4310h              { get entry point address of driver }
    int 2Fh
    mov word ptr XMST + 2,es
    mov word ptr XMST + 0,bx
    xor ax,ax                 { get version numb }
    call dword ptr [XMST]
    cmp  ax,0200h
    jb   @No_XMSdriver     { if version < 2.0 then cancel ! }
    mov  XMS_Version,ax
    mov  XMS_Available,0
@No_XMSdriver:
    mov XMS_Available,1
@End_XMS_Check:
end;

procedure Check_for_EMS;
var emsseg : word;
    emsptr : pointer;
    emshead : EMS_Header;
begin;
  asm
    mov ax,3567h
    int 21h
    mov emsseg,es
  end;
  move(ptr(emsseg,0)^,emshead,17);
  if emshead.ID = 'EMMXXXX' then begin;
    EMS_Available := true;
    asm
      mov ah,40h                 { get EMS driver status }
      int 67h
      cmp ah,0
      jne @EMS_Vers_Error
      mov ah,46h                 { get EMS version }
      int 67h
      cmp ah,0
      jne @EMS_Vers_Error
      mov bl,al
      shr al,4
      mov bh,al                 { bh = Vers.maj }
      or  bl,0Fh                { bl = Vers.min }
      mov EMS_Version,bx
      jmp @EMS_Vers_End
@EMS_Vers_Error:
      mov EMS_Available,1
@EMS_Vers_End:
    end;
  end else begin;
    EMS_Available := false;
  end;
end;

Function EMS_Segment_determine(VAR Segment : word) : byte;
VAR hseg : word;
    fresult : byte;
begin;
  asm
    mov ah,41h
    int 67h
    cmp ah,0
    jne @EMS_Segdet_Error
    mov hseg,bx
    mov fresult,0
    jmp @EMS_Segdet_End
@EMS_Segdet_Error:
    mov fresult,ah
@EMS_Segdet_End:
  end;
  Segment := hseg;
  EMS_Segment_determine := fresult;
end;

Function EMS_Get_PageNumber : byte;
var fresult : byte;
begin;
  asm
    mov ah,42h
    int 67h
    cmp ah,0
    jne @EMS_GetPages_Error
    mov EMS_Pages_Free,bx
    mov EMS_Pages_Tot,dx
    mov fresult,0
    jmp @EMS_GetPages_End
@EMS_GetPages_Error:
    mov fresult,ah
@EMS_GetPages_End:
  end;
  EMS_Get_PageNumber := fresult;
end;

function EMS_free  : longint;
var    help : longint;
begin;
  EMS_Get_PageNumber;
  help := EMS_Pages_Free;
  EMS_free := help SHL 14;
end;

Function Getmem_EMS(VAR H : EMSHandle; Size : longint) : byte;
var Fresult : byte;
    EPages : word;
    Hhandle : word;
begin;
  EPages := (Size DIV 16384) + 1;
  asm
    mov ah,43h
    mov bx,EPages
    int 67h
    cmp ah,0
    jne @Getmem_Ems_Error
    mov Hhandle,dx
    mov fresult,0
    jmp @Getmem_Ems_End
@Getmem_Ems_Error:
    mov Fresult,ah
@Getmem_Ems_End:
  end;
  H := Hhandle;
  Getmem_EMS := Fresult;
end;

Function Freemem_EMS(H : EMSHandle) : byte;
var Fresult : byte;
begin;
  asm
    mov ah,45h
    mov dx,H
    int 67h
    mov Fresult,ah
  end;
  Freemem_EMS := Fresult;
end;

Function EMS_Allocation(H : EMSHandle;PagePage,EMSPage : word) : byte;
VAR Fresult : byte;
begin;
  asm
    mov ah,44h
    mov al,byte ptr PagePage
    mov bx,EMSPage
    mov dx,H
    int 67h
    mov Fresult,ah
  end;
  EMS_Allocation := Fresult;
end;

Function EMS_Protect_Allocation(H : EMSHandle) : byte;
VAR Fresult : byte;
begin;
  asm
    mov ah,47h
    mov dx,H
    int 67h
    mov Fresult,ah
  end;
  EMS_Protect_Allocation := Fresult;
end;

Function EMS_Unprotect_Allocation(H : EMSHandle) : byte;
VAR Fresult : byte;
begin;
  asm
    mov ah,48h
    mov dx,H
    int 67h
    mov Fresult,ah
  end;
  EMS_Unprotect_Allocation := Fresult;
end;

Function RAM_2_EMS(q : pointer; H : EMSHandle; Size : longint) : byte;
VAR fresult : byte;
    EMSseg    : word;
    hp        : ^byte;
    li        : word;
begin;
  EMS_Segment_determine(EMSseg);
  hp := q;
  if Size > 16384 then begin;
    { More than one page required }
    for li := 0 to (Size SHR 14)-1 do begin;
      EMS_Allocation(H,0,li);
      move(hp^,ptr(EMSseg,0)^,16384);
      dec(Size,16384);
      inc(hp,16384);
    end;
    EMS_Allocation(H,0,li+1);
    move(hp^,ptr(EMSseg,0)^,16384);
    dec(Size,16384);
    inc(hp,16384);
  end else begin;
    EMS_Allocation(H,0,0);
    move(hp^,ptr(EMSseg,0)^,16384);
    dec(Size,16384);
    inc(hp,16384);
  end;
end;

Function EMS_2_RAM(q : pointer; H : EMSHandle; Size : longint) : byte;
VAR fresult : byte;
    EMSseg    : word;
    hp        : ^byte;
    li        : word;
begin;
  EMS_Segment_determine(EMSseg);
  hp := q;
  if Size > 16384 then begin;
    { More than one page required }
    for li := 0 to (Size SHR 14)-1 do begin;
      EMS_Allocation(H,0,li);
      move(ptr(EMSseg,0)^,hp^,16384);
      dec(Size,16384);
      inc(hp,16384);
    end;
    EMS_Allocation(H,0,li+1);
    move(ptr(EMSseg,0)^,hp^,16384);
    dec(Size,16384);
    inc(hp,16384);
  end else begin;
    EMS_Allocation(H,0,0);
    move(ptr(EMSseg,0)^,hp^,16384);
    dec(Size,16384);
    inc(hp,16384);
  end;
end;

Function EMS_Pages_allocated(H : EMSHandle;var Pages : word) : byte;
var fresult : byte;
    Hs : word;
begin;
  asm
    mov ah,4Ch
    mov dx,H
    int 67h
    mov HS,bx
    mov fresult,ah
  end;
  Pages := Hs;
  EMS_Pages_allocated := Fresult;
end;

Function EMS_Handles_assign(Var Number : word) : byte;
Var Fresult : byte;
    Han       : word;
begin;
  asm
    mov ah,4Bh
    int 67h
    mov Han,bx
    mov Fresult,ah
  end;
  Number := Han;
  EMS_Handles_assign := Fresult;
end;

function XMS_lock(H : XMSHandle) : longint; assembler;
asm;
  mov ax,0c00h
  mov dx,h
  call dword ptr [XMST]
  mov ax,bx
end;

procedure XMS_unlock(H : XMSHandle); assembler;
asm;
  mov ax,0d00h
  mov dx,h
  call dword ptr [XMST]
end;


begin;
  Check_for_XMS;
  Check_for_EMS;
end.