PC Interdit/pc-interdit.iso/memory/xms/memory.pas

Pascal/Delphi Source File | 1994-10-27 | 10KB | 455 lines

{ **************************************************************************
  ***   Unité mémoire du livre PC interdit de MICRO APPLICATION          ***
  ***   Auteur           : Boris Bertelsons                              ***
  ***   Date             : 26.01.1994                                    ***
  ***   Dernière version : 18.03.1994                                    ***
  **************************************************************************
}
Unit memory;

Interface

uses dos;

TYPE XMSHandle = word;

     EMSHandle = word;

     XMS_Copyblock = Record
       Size     : longint;
       Q_Handle : Word;
       Q_Offset : pointer;
       Z_Handle : Word;
       Z_Offset : pointer;
     end;

     EMS_Header = Record        { Identification de l'EMS }
       dummy          : array[0..9] of byte;
       Identification : array[1..7] of char;
     end;

VAR XMS_Existe      : boolean;  { TRUE, s'il y a une XMS }
    XMST            : pointer;  { Driver - adresse d'entrée }
    XMS_Version     : word;     { la version du driver XMS }
    XC              : XMS_Copyblock;
    EMS_Existe      : boolean;  { TRUE, s'il y a une EMS }
    EMS_Version     : word;     { Le nombre de la version EMS.
                                  Vers.MAJ est dans le Hi-Byte
                                  et VERS.MIN dans le Lo-Byte}                                  Lo-Byte ! }
    EMS_Pages_libres : word;     {Le nombre de EMS pages libres}
    EMS_Pages_Insg  : word;     { La totalité des pages
                                  EMS disponibles }


implementation

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

function XMS_free  : longint;
var xms_en_kb : word;
    xms_long: longint;
begin;
  asm
    mov ax,0800h                 { 8 = donne la mémoire libre}
    call dword ptr [XMST]
    mov xms_en_kb,dx
  end;
  xms_long := xms_en_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 = allouer l'espace en mémoire }
    mov dx,bsize
    call dword ptr [XMST]
    cmp ax,1
    jne @Erreur_GetmemXms
    mov xmsh,dx
    mov Fresult,0
    jmp @Fin_GetmemXms
@Erreur_GetmemXMS:
    mov Fresult,bl
@Fin_GetmemXms:
  end;
  h := xmsh;
  Getmem_Xms := Fresult;
end;

Function Freemem_XMS(H : XMSHandle) : byte;
var fresult : byte;
begin;
  asm                            { A = libère l'espace réservé en mémoire }
    mov ax,0a00h
    call dword ptr [XMST]
    cmp ax,1
    jne @Erreur_FreememXms
    mov Fresult,0
    jmp @Fin_FreememXms
@Erreur_FreememXms:
    mov Fresult,bl
@Fin_FreememXms:
  end;
end;

Function XMS_2_XMS(h1,h2 : XMSHandle; Size : Word) : byte;
VAR fresult : byte;
begin;
  XC.Size     := Size;    { Taille du bloc en octets }
  XC.Q_Handle := h1;      { Handle source }
  XC.Q_Offset := nil;     { Offset source, 0 = Début du bloc }
  XC.Z_Handle := h2;      { Handle cible }
  XC.Z_Offset := nil;     { Offset cible }
  asm
    mov si,offset XC
    mov ax,0B00h
    call dword ptr [XMST]
    cmp ax,1
    jne @Erreur_RAM2XMS
    mov fresult,0
    jmp @Fin_Ram2XMS
@Erreur_Ram2XMS:
    mov fresult,bl
@Fin_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 @Erreur_RAM2XMS
    mov fresult,0
    jmp @Fin_Ram2XMS
@Erreur_Ram2XMS:
    mov fresult,bl
@Fin_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 @Erreur_XMS2RAM
    mov fresult,0
    jmp @Fin_XMS2Ram
@Erreur_XMS2Ram:
    mov fresult,bl
@Fin_XMS2Ram:
  end;
end;

Procedure Check_for_XMS; assembler;
  asm
    mov ax,4300h              {Vérifie s'il y a un gestionnaire installé}
    int 2Fh
    cmp al,80h
    jne @Pas_de_gestXMS
    mov ax,4310h              {Donne l'adresse d'entrée du gestionnaire}
    int 2Fh
    mov word ptr XMST + 2,es
    mov word ptr XMST + 0,bx
    xor ax,ax                 {Donne le numéro de version}
    call dword ptr [XMST]
    cmp  ax,0200h
    jb   @Pas_de_gestXMS     { Si Version < 2.0, arrêt ! }
    mov  XMS_Version,ax
    mov  XMS_Existe,0
@Pas_de_gestXMS:
    mov XMS_Existe,1
@Fin_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.Identification = 'EMMXXXX' then begin;
    EMS_Existe := true;
    asm
      mov ah,40h  {Donne l'état du gestionnaire EMS}
      int 67h
      cmp ah,0
      jne @EMS_Vers_Erreur
      mov ah,46h  {Donne la version EMS}
      int 67h
      cmp ah,0
      jne @EMS_Vers_Erreur
      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_Fin
@EMS_Vers_Erreur:
      mov EMS_Existe,1
@EMS_Vers_Fin:
    end;
  end else begin;
    EMS_Existe := false;
  end;
end;

Function EMS_Segment_obtenir(VAR Segment : word) : byte;
VAR hseg : word;
    fresultat : byte;
begin;
  asm
    mov ah,41h
    int 67h
    cmp ah,0
    jne @EMS_Segerm_Erreur
    mov hseg,bx
    mov fresultat,0
    jmp @EMS_Segerm_Fin
@EMS_Segerm_Erreur:
    mov fresultat,ah
@EMS_Segerm_Fin:
  end;
  Segment := hseg;
  EMS_Segment_obtenir := fresultat;
end;

Function EMS_Obtenir_Nombre_Pages : byte;
var fresultat : byte;
begin;
  asm
    mov ah,42h
    int 67h
    cmp ah,0
    jne @EMS_ObtPages_Erreur
    mov EMS_Pages_libres,bx
    mov EMS_Pages_Insg,dx
    mov fresultat,0
    jmp @EMS_ObtPages_Fin
@EMS_ObtPages_Erreur:
    mov fresultat,ah
@EMS_ObtPages_Fin:
  end;
  EMS_Obtenir_Nombre_Pages := fresultat;
end;

function EMS_free  : longint;
var    aide : longint;
begin;
  EMS_Obtenir_Nombre_Pages;
  aide := EMS_Pages_Libres;
  EMS_free := aide SHL 14;
end;

Function Getmem_EMS(VAR H : EMSHandle; Size : longint) : byte;
var Fresultat : 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_Erreur
    mov Hhandle,dx
    mov fresultat,0
    jmp @Getmem_Ems_Fin
@Getmem_Ems_Erreur:
    mov Fresultat,ah
@Getmem_Ems_Fin:
  end;
  H := Hhandle;
  Getmem_EMS := Fresultat;
end;

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

Function EMS_Affecter(H : EMSHandle;NumPage,PageEMS : word) : byte;
VAR Fresultat : byte;
begin;
  asm
    mov ah,44h
    mov al,byte ptr NumPage
    mov bx,PageEMS
    mov dx,H
    int 67h
    mov Fresultat,ah
  end;
  EMS_Affecter := Fresultat;
end;

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

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

Function RAM_2_EMS(q : pointer; H : EMSHandle; Size : longint) : byte;
VAR fresultat : byte;
    EMSseg    : word;
    hp        : ^byte;
    li        : word;
begin;
  EMS_Segment_Obtenir(EMSseg);
  hp := q;
  if Size > 16384 then begin;
    {Il faut plus d'une page}
    for li := 0 to (Size SHR 14)-1 do begin;
      EMS_Affecter(H,0,li);
      move(hp^,ptr(EMSseg,0)^,16384);
      dec(Size,16384);
      inc(hp,16384);
    end;
    EMS_Affecter(H,0,li+1);
    move(hp^,ptr(EMSseg,0)^,16384);
    dec(Size,16384);
    inc(hp,16384);
  end else begin;
    EMS_Affecter(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 Fresultat : byte;
    EMSseg    : word;
    hp        : ^byte;
    li        : word;
begin;
  EMS_Segment_Obtenir(EMSseg);
  hp := q;
  if Size > 16384 then begin;
    { Plus d'une page nécessaire }
    for li := 0 to (Size SHR 14)-1 do begin;
      EMS_Affecter(H,0,li);
      move(ptr(EMSseg,0)^,hp^,16384);
      dec(Size,16384);
      inc(hp,16384);
    end;
    EMS_Affecter(H,0,li+1);
    move(ptr(EMSseg,0)^,hp^,16384);
    dec(Size,16384);
    inc(hp,16384);
  end else begin;
    EMS_Affecter(H,0,0);
    move(ptr(EMSseg,0)^,hp^,16384);
    dec(Size,16384);
    inc(hp,16384);
  end;
end;

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

Function EMS_Handles_disponibles(Var Nombre : word) : byte;
Var Fresultat : byte;
    Han       : word;
begin;
  asm
    mov ah,4Bh
    int 67h
    mov Han,bx
    mov Fresultat,ah
  end;
  Nombre := Han;
  EMS_Handles_disponibles:= Fresultat;
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.