home *** CD-ROM | disk | FTP | other *** search
/ PC Interdit / pc-interdit.iso / memory / flat / rmem.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-10-31  |  12.2 KB  |  372 lines
  1. {
  2.  
  3.  ****************************************************************************
  4.  ***                   MICRO APPLICATION PC INTERDIT                      ***
  5.  ***                  ================================                    ***
  6.  ***                                                                      ***
  7.  ***              Unité destinée à l'utilisation d'un modèle flat         ***
  8.  ***                                                                      ***
  9.  *** L'unité met des routines à votre disposition, qui vous permet de     ***
  10.  *** recourir au mode réel de toute la mémoire du PC.                     ***
  11.  *** Condition : Il ne faut pas avoir installé un gestionnaire de         ***
  12.  *** mémoire comme EMM386 ou QEMM.  Par contre on a besoin de             ***
  13.  *** HYMEM.SYS                                                                     ***
  14.  *** Auteur           : Boris Bertelsons  (InspirE)                       ***
  15.  *** Nom de fichier   : RMEM.PAS                                          ***
  16.  *** Dernière modif.  : 28.04.1994                                        ***
  17.  *** Version          : 1.0                                               ***
  18.  *** Compilateur      : Turbo Pascal 7                                    ***
  19.  ****************************************************************************
  20.  
  21. }
  22. unit rmem;
  23. interface
  24.  
  25. uses crt;
  26.  
  27. const Rmem_Max : longint = 3*1024*1024-70000;
  28.  
  29. const GDT : array[1..16] of byte =(
  30.   $00,$00,$00,$00,$00,$00,$00,$00,        {GDT indice 0 (null segment)}
  31.   $FF,$FF,$00,$00,$00,$92,$CF,$FF);       {GDT indice 1 (seg 0, limit 4GB)}
  32.  
  33. var GDT_Off : array[1..6] of byte;
  34.  
  35. procedure memory_checks(minmain,minxms : word);
  36. procedure enable_Realmem(Min : word);
  37. procedure Exit_Rmem;
  38.  
  39. function  Rgetmem(Var rpos : longint;rsize : longint) : boolean;
  40. procedure Rmem_Lire(Source:longint; Cible:pointer;Long:word);
  41. procedure Rmem_write(Source:pointer;Cible:longint;Long:word);
  42.  
  43.  
  44. implementation
  45.  
  46. uses dos;
  47.  
  48. TYPE XMSHandle = word;
  49.  
  50.      XMS_Copyblock = Record     { On en a besoin pour les routines de copie }
  51.        Size     : longint;
  52.        Q_Handle : Word;
  53.        Q_Offset : pointer;
  54.        Z_Handle : Word;
  55.        Z_Offset : pointer;
  56.      end;
  57.  
  58. VAR XMS_Existe   : boolean;  { TRUE, si XMS est Existe }
  59.     XMST            : pointer;  { Driver - adresse d'entrée}
  60.     XMS_Version     : word;     { renvoie la version du pilote XMS}
  61.     XC              : XMS_Copyblock;
  62.     xms_Libre : longint;
  63.     error : byte;
  64.     My_XmsHandle : XmsHandle;
  65.     Xms_startposi : longint;
  66.     Old_ExitprocRmem : pointer;
  67.  
  68.  
  69. function XMS_free  : longint;
  70. var xms_in_kb : word;
  71.     xms_long: longint;
  72. begin;
  73.   asm
  74.     mov ax,0800h                 { 8 = renvoie mémoire disponible }
  75.     call dword ptr [XMST]
  76.     mov xms_in_kb,dx
  77.   end;
  78.   xms_long := xms_in_kb;
  79.   XMS_free := xms_long * 1024;
  80. end;
  81.  
  82. Function Getmem_XMS(VAR H : XMSHandle; Size : longint) : byte;
  83. var bsize : word;
  84.     Fresult : byte;
  85.     xmsh : word;
  86. begin;
  87.   bsize := (size DIV 1024) + 1;
  88.   asm
  89.     mov ax,0900h                 { 9 = allocation taille de mémoire }
  90.     mov dx,bsize
  91.     call dword ptr [XMST]
  92.     cmp ax,1
  93.     jne @Erreur_GetmemXms
  94.     mov xmsh,dx
  95.     mov Fresult,0
  96.     jmp @fin_GetmemXms
  97. @Erreur_GetmemXMS:
  98.     mov Fresult,bl
  99. @fin_GetmemXms:
  100.   end;
  101.   h := xmsh;
  102.   Getmem_Xms := Fresult;
  103. end;
  104.  
  105. Function Freemem_XMS(H : XMSHandle) : byte;
  106. var fresult : byte;
  107. begin;
  108.   asm                            { A = deallocation taille de mémoire }
  109.     mov ax,0a00h
  110.     mov dx,h
  111.     call dword ptr [XMST]
  112.     cmp ax,1
  113.     jne @Erreur_FreememXms
  114.     mov Fresult,0
  115.     jmp @fin_FreememXms
  116. @Erreur_FreememXms:
  117.     mov Fresult,bl
  118. @fin_FreememXms:
  119.   end;
  120. end;
  121.  
  122. Procedure Check_for_XMS; assembler;
  123.   asm
  124.     mov ax,4300h              { vérifier si pilote a été installé }
  125.     int 2Fh
  126.     cmp al,80h
  127.     jne @Kein_XMSTreiber
  128.     mov ax,4310h              { adresse de démarrage du pilote }
  129.     int 2Fh
  130.     mov word ptr XMST + 2,es
  131.     mov word ptr XMST + 0,bx
  132.     xor ax,ax                 { chercher n° de version }
  133.     call dword ptr [XMST]
  134.     cmp  ax,0200h
  135.     jb   @Kein_XMSTreiber     { si version < 2.0 : annuler ! }
  136.     mov  XMS_Version,ax
  137.     mov  XMS_Existe,0
  138. @Kein_XMSTreiber:
  139.     mov XMS_Existe,1
  140. @fin_XMS_Check:
  141. end;
  142.  
  143. function XMS_lock(H : XMSHandle) : longint; assembler;
  144. asm;
  145.   mov ax,0c00h
  146.   mov dx,h
  147.   call dword ptr [XMST]
  148.   mov ax,bx
  149. end;
  150.  
  151. procedure XMS_unlock(H : XMSHandle); assembler;
  152. asm;
  153.   mov ax,0d00h
  154.   mov dx,h
  155.   call dword ptr [XMST]
  156. end;
  157.  
  158. procedure XMS_Enable_A20; assembler;
  159. asm
  160.   mov ax,0500h
  161.   call dword ptr [XMST]
  162. end;
  163.  
  164. procedure XMS_Disable_A20; assembler;
  165. asm
  166.   mov ax,0600h
  167.   call dword ptr [XMST]
  168. end;
  169.  
  170.  
  171. const MByte1: longint = $100000;
  172.  
  173. var Offs,Segm : word;
  174.     Rmemposi  : longint;
  175.  
  176. {$l c:\edition\prog\fr\asm\rmemasm.obj}
  177. procedure mem_write(q:longint;zl,zh,l:word); far; external;
  178. {
  179.  *************************************************************************
  180.  ***                                                                   ***
  181.  ***    Copie d'un bloc à partir de la mémoire principale dans le RME  ***
  182.  ***                                                                   ***
  183.  *************************************************************************
  184. }
  185.  
  186. procedure mem_Lire(q:longint;zl,zh,l:word); far; external;
  187. {
  188.  *************************************************************************
  189.  ***                                                                   ***
  190.  ***      Copie d'un bloc à partir du RMEM dans la mémoire principale  ***
  191.  ***                                                                   ***
  192.  *************************************************************************
  193. }
  194.  
  195. procedure Enable_4Giga; far; external;
  196. {
  197.  *************************************************************************
  198.  ***                                                                   ***
  199.  ***      Transfère le contrôle du procésseur dans le modèle flat      ***
  200.  ***                                                                   ***
  201.  *************************************************************************
  202. }
  203.  
  204. function Multitache_actif : boolean; far; external;
  205. {
  206.  *************************************************************************
  207.  ***                                                                    ***
  208.  ***  Vérifie si un programme multitache comme QEMM ou EMM386 est actif ***
  209.  ***                                                                    ***
  210.  *************************************************************************
  211. }
  212.  
  213. procedure Rmem_Lire(Source:longint; Cible:pointer;Long:word);
  214. {
  215.  *************************************************************************
  216.  ***                                                                   ***
  217.  ***   Copie d'un bloc à partir du RMEM dans la mémoire principale     ***
  218.  ***                                                                   ***
  219.  *************************************************************************
  220. }
  221. begin
  222.  if Source + Long < Rmem_Max then begin
  223.    Segm:=seg(Cible^);
  224.    Offs:=ofs(Cible^);
  225.    inc(Segm,Offs div 16);
  226.    Offs:=Offs mod 16;
  227.    inc(Source,MByte1);
  228.    mem_Lire(Source,Offs,Segm,Long);
  229.   end else begin;
  230.     asm mov ax,0003; int 10h; end;
  231.     writeln('Error reading back XMS Realmemory !');
  232.     writeln('System halted');
  233.     halt(0);
  234.   end;
  235. end;
  236.  
  237. procedure Rmem_write(Source:pointer;Cible:longint;Long:word);
  238. {
  239.  *************************************************************************
  240.  ***                                                                   ***
  241.  *** Copie d'un bloc à partir de la mémoire principale dans le RMEM    ***
  242.  ***                                                                   ***
  243.  *************************************************************************
  244. }
  245. begin
  246.  if Cible+Long < Rmem_Max then begin
  247.    Segm := seg(Source^);
  248.    Offs := ofs(Source^);
  249.    inc(Segm,Offs div 16);
  250.    Offs := Offs mod 16;
  251.    inc(Cible,MByte1);
  252.    mem_write(Cible, Offs,Segm,Long);
  253.   end else begin;
  254.     asm mov ax,0003; int 10h; end;
  255.     writeln('XMS allocation error ! Not enough memory ?');
  256.     writeln('System halted');
  257.     halt(0);
  258.   end;
  259. end;
  260.  
  261. procedure memory_checks(minmain,minxms : word);
  262. {
  263.  *************************************************************************
  264.  ***                                                                   ***
  265.  ***     Vérifie, s'il y a assez de mémoire disponible                 ***
  266.  ***                                                                   ***
  267.  *************************************************************************
  268. }
  269. var xmsfree,mainfree : word;
  270. begin;
  271.   { Libreen XMS - détecter type de mémoire }
  272.   xmsfree := xms_free;
  273.   { détecter type de mémoire principale }
  274.   mainfree := memavail div 1024;
  275.   { Message, s'il n'y a pas assez de mémoire disponible }
  276.   if (xmsfree < minxms) or (mainfree < minmain) then begin;
  277.     asm mov ax,0003; int 10h; end;
  278.     writeln('Sorry, not enough memory available !');
  279.     writeln('           You need       Available');
  280.     writeln('XMS :     ',minxms :6,' KB         ',xmsfree:4,' KB');
  281.     writeln('Main:     ',minmain:6,' KB         ',mainfree:4,' KB');
  282.     halt(0);
  283.   end;
  284. end;
  285.  
  286. function Rgetmem(Var rpos : longint;rsize : longint) : boolean;
  287. {
  288.  *************************************************************************
  289.  ***                                                                   ***
  290.  ***        Une procédure - simplifié - Getmem pour le RMEM            ***
  291.  ***                                                                   ***
  292.  *************************************************************************
  293. }
  294. begin;
  295.   if Rmemposi+rsize > Rmem_max then begin;
  296.     Rgetmem := false;
  297.   end else begin;
  298.     rpos := Rmemposi;
  299.     inc(Rmemposi,rsize);
  300.     Rgetmem := true;
  301.   end;
  302. end;
  303.  
  304. procedure Exit_Rmem;
  305. {
  306.  *************************************************************************
  307.  ***                                                                   ***
  308.  ***     procédure de Exit du RMEM, DOIT être appelé !                 ***
  309.  ***                                                                   ***
  310.  *************************************************************************
  311. }
  312. begin;
  313.   { débloquer bloc }
  314.   XMS_unlock(My_XmsHandle);
  315.   { mémoire Libredonner }
  316.   Freemem_XMS(My_XmsHandle);
  317. end;
  318.  
  319. procedure enable_Realmem(Min : word);
  320. {
  321.  *************************************************************************
  322.  ***                                                                   ***
  323.  ***               Bascule dans le mode RMEM                           ***
  324.  ***    Il faut une MIN" KB Libreer XMS Existe !                       ***
  325.  ***                                                                   ***
  326.  *************************************************************************
  327. }
  328. begin
  329.  { Vérifier s'il y a multitache ... }
  330.  if Multitache_actif then begin;
  331.    asm mov ax,0003; int 10h; end;
  332.    writeln('Processor already in V86 mode !');
  333.    writeln('Please reboot without any EMS-drivers such as EMM386, QEMM etc.');
  334.    writeln('HIMEM.SYS is required ! ');
  335.    halt(0);
  336.  end;
  337.  { pilote XMS installé ?  }
  338.  if not XMS_Existe then begin;
  339.    asm mov ax,0003; int 10h; end;
  340.    writeln('No XMS or Himem-driver available');
  341.    writeln('Please reboot your System using HIMEM.SYS !!!');
  342.    halt(0);
  343.  end;
  344.  { allouer la mémoire qui est nécessaire }
  345.  error := Getmem_XMS(My_XmsHandle,min*1024);
  346.  if error <> 0 then begin;
  347.    asm mov ax,0003; int 10h; end;
  348.    writeln('Error during memory-allocation !');
  349.    writeln('We need at least ',Min,' KB of free XMS Memory !!!');
  350.    writeln('Please reboot your System using HIMEM.SYS');
  351.    writeln;
  352.    halt(0);
  353.  end;
  354.  { détection de la position physique de démarrage }
  355.  Rmemposi := XMS_lock(My_XmsHandle);
  356.  if rmemposi < 1000000 then begin;
  357.    asm mov ax,0003; int 10h; end;
  358.    writeln('Error during memory-fixing !');
  359.    writeln('We need at least ',Min,' KB of free XMS Memory !!!');
  360.    writeln('Please reboot your System using HIMEM.SYS');
  361.    writeln;
  362.    halt(0);
  363.  end;
  364.  { activer Libre }
  365.  Enable_4Giga;
  366. end;
  367.  
  368. begin;
  369.   Check_for_XMS;
  370.   Rmem_Max := XMS_Free;
  371. end.
  372.