home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC Interdit
/
pc-interdit.iso
/
memory
/
xms
/
memory.pas
< prev
next >
Wrap
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.