home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC Interdit
/
pc-interdit.iso
/
memory
/
flat
/
rmem.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-10-31
|
12KB
|
372 lines
{
****************************************************************************
*** MICRO APPLICATION PC INTERDIT ***
*** ================================ ***
*** ***
*** Unité destinée à l'utilisation d'un modèle flat ***
*** ***
*** L'unité met des routines à votre disposition, qui vous permet de ***
*** recourir au mode réel de toute la mémoire du PC. ***
*** Condition : Il ne faut pas avoir installé un gestionnaire de ***
*** mémoire comme EMM386 ou QEMM. Par contre on a besoin de ***
*** HYMEM.SYS ***
*** Auteur : Boris Bertelsons (InspirE) ***
*** Nom de fichier : RMEM.PAS ***
*** Dernière modif. : 28.04.1994 ***
*** Version : 1.0 ***
*** Compilateur : Turbo Pascal 7 ***
****************************************************************************
}
unit rmem;
interface
uses crt;
const Rmem_Max : longint = 3*1024*1024-70000;
const GDT : array[1..16] of byte =(
$00,$00,$00,$00,$00,$00,$00,$00, {GDT indice 0 (null segment)}
$FF,$FF,$00,$00,$00,$92,$CF,$FF); {GDT indice 1 (seg 0, limit 4GB)}
var GDT_Off : array[1..6] of byte;
procedure memory_checks(minmain,minxms : word);
procedure enable_Realmem(Min : word);
procedure Exit_Rmem;
function Rgetmem(Var rpos : longint;rsize : longint) : boolean;
procedure Rmem_Lire(Source:longint; Cible:pointer;Long:word);
procedure Rmem_write(Source:pointer;Cible:longint;Long:word);
implementation
uses dos;
TYPE XMSHandle = word;
XMS_Copyblock = Record { On en a besoin pour les routines de copie }
Size : longint;
Q_Handle : Word;
Q_Offset : pointer;
Z_Handle : Word;
Z_Offset : pointer;
end;
VAR XMS_Existe : boolean; { TRUE, si XMS est Existe }
XMST : pointer; { Driver - adresse d'entrée}
XMS_Version : word; { renvoie la version du pilote XMS}
XC : XMS_Copyblock;
xms_Libre : longint;
error : byte;
My_XmsHandle : XmsHandle;
Xms_startposi : longint;
Old_ExitprocRmem : pointer;
function XMS_free : longint;
var xms_in_kb : word;
xms_long: longint;
begin;
asm
mov ax,0800h { 8 = renvoie mémoire disponible }
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 = allocation taille de 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 = deallocation taille de mémoire }
mov ax,0a00h
mov dx,h
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;
Procedure Check_for_XMS; assembler;
asm
mov ax,4300h { vérifier si pilote a été installé }
int 2Fh
cmp al,80h
jne @Kein_XMSTreiber
mov ax,4310h { adresse de démarrage du pilote }
int 2Fh
mov word ptr XMST + 2,es
mov word ptr XMST + 0,bx
xor ax,ax { chercher n° de version }
call dword ptr [XMST]
cmp ax,0200h
jb @Kein_XMSTreiber { si version < 2.0 : annuler ! }
mov XMS_Version,ax
mov XMS_Existe,0
@Kein_XMSTreiber:
mov XMS_Existe,1
@fin_XMS_Check:
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;
procedure XMS_Enable_A20; assembler;
asm
mov ax,0500h
call dword ptr [XMST]
end;
procedure XMS_Disable_A20; assembler;
asm
mov ax,0600h
call dword ptr [XMST]
end;
const MByte1: longint = $100000;
var Offs,Segm : word;
Rmemposi : longint;
{$l c:\edition\prog\fr\asm\rmemasm.obj}
procedure mem_write(q:longint;zl,zh,l:word); far; external;
{
*************************************************************************
*** ***
*** Copie d'un bloc à partir de la mémoire principale dans le RME ***
*** ***
*************************************************************************
}
procedure mem_Lire(q:longint;zl,zh,l:word); far; external;
{
*************************************************************************
*** ***
*** Copie d'un bloc à partir du RMEM dans la mémoire principale ***
*** ***
*************************************************************************
}
procedure Enable_4Giga; far; external;
{
*************************************************************************
*** ***
*** Transfère le contrôle du procésseur dans le modèle flat ***
*** ***
*************************************************************************
}
function Multitache_actif : boolean; far; external;
{
*************************************************************************
*** ***
*** Vérifie si un programme multitache comme QEMM ou EMM386 est actif ***
*** ***
*************************************************************************
}
procedure Rmem_Lire(Source:longint; Cible:pointer;Long:word);
{
*************************************************************************
*** ***
*** Copie d'un bloc à partir du RMEM dans la mémoire principale ***
*** ***
*************************************************************************
}
begin
if Source + Long < Rmem_Max then begin
Segm:=seg(Cible^);
Offs:=ofs(Cible^);
inc(Segm,Offs div 16);
Offs:=Offs mod 16;
inc(Source,MByte1);
mem_Lire(Source,Offs,Segm,Long);
end else begin;
asm mov ax,0003; int 10h; end;
writeln('Error reading back XMS Realmemory !');
writeln('System halted');
halt(0);
end;
end;
procedure Rmem_write(Source:pointer;Cible:longint;Long:word);
{
*************************************************************************
*** ***
*** Copie d'un bloc à partir de la mémoire principale dans le RMEM ***
*** ***
*************************************************************************
}
begin
if Cible+Long < Rmem_Max then begin
Segm := seg(Source^);
Offs := ofs(Source^);
inc(Segm,Offs div 16);
Offs := Offs mod 16;
inc(Cible,MByte1);
mem_write(Cible, Offs,Segm,Long);
end else begin;
asm mov ax,0003; int 10h; end;
writeln('XMS allocation error ! Not enough memory ?');
writeln('System halted');
halt(0);
end;
end;
procedure memory_checks(minmain,minxms : word);
{
*************************************************************************
*** ***
*** Vérifie, s'il y a assez de mémoire disponible ***
*** ***
*************************************************************************
}
var xmsfree,mainfree : word;
begin;
{ Libreen XMS - détecter type de mémoire }
xmsfree := xms_free;
{ détecter type de mémoire principale }
mainfree := memavail div 1024;
{ Message, s'il n'y a pas assez de mémoire disponible }
if (xmsfree < minxms) or (mainfree < minmain) then begin;
asm mov ax,0003; int 10h; end;
writeln('Sorry, not enough memory available !');
writeln(' You need Available');
writeln('XMS : ',minxms :6,' KB ',xmsfree:4,' KB');
writeln('Main: ',minmain:6,' KB ',mainfree:4,' KB');
halt(0);
end;
end;
function Rgetmem(Var rpos : longint;rsize : longint) : boolean;
{
*************************************************************************
*** ***
*** Une procédure - simplifié - Getmem pour le RMEM ***
*** ***
*************************************************************************
}
begin;
if Rmemposi+rsize > Rmem_max then begin;
Rgetmem := false;
end else begin;
rpos := Rmemposi;
inc(Rmemposi,rsize);
Rgetmem := true;
end;
end;
procedure Exit_Rmem;
{
*************************************************************************
*** ***
*** procédure de Exit du RMEM, DOIT être appelé ! ***
*** ***
*************************************************************************
}
begin;
{ débloquer bloc }
XMS_unlock(My_XmsHandle);
{ mémoire Libredonner }
Freemem_XMS(My_XmsHandle);
end;
procedure enable_Realmem(Min : word);
{
*************************************************************************
*** ***
*** Bascule dans le mode RMEM ***
*** Il faut une MIN" KB Libreer XMS Existe ! ***
*** ***
*************************************************************************
}
begin
{ Vérifier s'il y a multitache ... }
if Multitache_actif then begin;
asm mov ax,0003; int 10h; end;
writeln('Processor already in V86 mode !');
writeln('Please reboot without any EMS-drivers such as EMM386, QEMM etc.');
writeln('HIMEM.SYS is required ! ');
halt(0);
end;
{ pilote XMS installé ? }
if not XMS_Existe then begin;
asm mov ax,0003; int 10h; end;
writeln('No XMS or Himem-driver available');
writeln('Please reboot your System using HIMEM.SYS !!!');
halt(0);
end;
{ allouer la mémoire qui est nécessaire }
error := Getmem_XMS(My_XmsHandle,min*1024);
if error <> 0 then begin;
asm mov ax,0003; int 10h; end;
writeln('Error during memory-allocation !');
writeln('We need at least ',Min,' KB of free XMS Memory !!!');
writeln('Please reboot your System using HIMEM.SYS');
writeln;
halt(0);
end;
{ détection de la position physique de démarrage }
Rmemposi := XMS_lock(My_XmsHandle);
if rmemposi < 1000000 then begin;
asm mov ax,0003; int 10h; end;
writeln('Error during memory-fixing !');
writeln('We need at least ',Min,' KB of free XMS Memory !!!');
writeln('Please reboot your System using HIMEM.SYS');
writeln;
halt(0);
end;
{ activer Libre }
Enable_4Giga;
end;
begin;
Check_for_XMS;
Rmem_Max := XMS_Free;
end.