home *** CD-ROM | disk | FTP | other *** search
/ PC Underground / UNDERGROUND.ISO / memory / flat / rmem.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-07-28  |  12.1 KB  |  372 lines
  1. {
  2.  
  3.  ****************************************************************************
  4.  ***                   ABACUS'  "PC UNDERGROUND"                          ***
  5.  ***                  ================================                    ***
  6.  ***                                                                      ***
  7.  ***                  Unit for using the Flat-Model                       ***
  8.  ***                                                                      ***
  9.  *** The unit makes routines available, with which the entire memory      ***
  10.  *** of the PC can be accessed in Real mode.                              ***
  11.  *** A Memory-Manager such as EMM386 or QEMM CANNOT be installed.         ***
  12.  *** HIMEM.SYS is required !                                              ***
  13.  ***                                                                      ***
  14.  *** Author          : Boris Bertelsons  (InspirE)                        ***
  15.  *** Filename        : RMEM.PAS                                           ***
  16.  *** Last Update     : 04/28/94                                           ***
  17.  *** Version         : 1.0                                                ***
  18.  *** Compiler        : Turbo Pascal 6.0 and above                         ***
  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 Entry 0 (null segment)}
  31.   $FF,$FF,$00,$00,$00,$92,$CF,$FF);       {GDT Entry 1 (seg 0, limit 4Gigabytes)}
  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_read(source:longint; destination:pointer;length:word);
  41. procedure Rmem_write(source:pointer;destination:longint;length:word);
  42.  
  43.  
  44. implementation
  45.  
  46. uses dos;
  47.  
  48. TYPE XMSHandle = word;
  49.  
  50.      XMS_Copyblock = Record     { Required for copy routines }
  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_Available    : boolean;  { TRUE, if XMS available }
  59.     XMST             : pointer;  { Driver - Entry point address }
  60.     XMS_Version      : word;     { Version of XMS driver }
  61.     XC               : XMS_Copyblock;
  62.     xms_free         : longint;
  63.     error            : byte;
  64.     My_XmsHandle     : XmsHandle;
  65.     Xms_startposi    : longint;
  66.     Old_ExitprocRmem : pointer;
  67.  
  68.  
  69. function XMS_free1 : longint;
  70. var xms_in_kb      : word;
  71.     xms_long       : longint;
  72. begin;
  73.   asm
  74.     mov ax,0800h                 { 8 = Get free memory }
  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 = Allocate memory area }
  90.     mov dx,bsize
  91.     call dword ptr [XMST]
  92.     cmp ax,1
  93.     jne @Error_GetmemXms
  94.     mov xmsh,dx
  95.     mov Fresult,0
  96.     jmp @End_GetmemXms
  97. @Error_GetmemXMS:
  98.     mov Fresult,bl
  99. @End_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 = deallocate memory area }
  109.     mov ax,0a00h
  110.     mov dx,h
  111.     call dword ptr [XMST]
  112.     cmp ax,1
  113.     jne @Error_FreememXms
  114.     mov Fresult,0
  115.     jmp @End_FreememXms
  116. @Error_FreememXms:
  117.     mov Fresult,bl
  118. @End_FreememXms:
  119.   end;
  120. end;
  121.  
  122. Procedure Check_for_XMS; assembler;
  123.   asm
  124.     mov ax,4300h              { Check whether driver installed }
  125.     int 2Fh
  126.     cmp al,80h
  127.     jne @No_XMSDriver
  128.     mov ax,4310h              { Get entry point address of driver }
  129.     int 2Fh
  130.     mov word ptr XMST + 2,es
  131.     mov word ptr XMST + 0,bx
  132.     xor ax,ax                 { Get version number }
  133.     call dword ptr [XMST]
  134.     cmp  ax,0200h
  135.     jb   @No_XMSDriver     { If version < 2.0 then cancel ! }
  136.     mov  XMS_Version,ax
  137.     mov  XMS_Available,0
  138. @No_XMSDriver:
  139.     mov XMS_Available,1
  140. @End_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 rmemasm.obj}
  177. procedure mem_write(q:longint;zl,zh,l:word); far; external;
  178. {
  179.  *************************************************************************
  180.  ***                                                                   ***
  181.  ***       Copies a block from RAM to RMEM                             ***
  182.  ***                                                                   ***
  183.  *************************************************************************
  184. }
  185.  
  186. procedure mem_read(q:longint;zl,zh,l:word); far; external;
  187. {
  188.  *************************************************************************
  189.  ***                                                                   ***
  190.  ***      Copies a block from RMEM to RAM                              ***
  191.  ***                                                                   ***
  192.  *************************************************************************
  193. }
  194.  
  195. procedure Enable_4Giga; far; external;
  196. {
  197.  *************************************************************************
  198.  ***                                                                   ***
  199.  ***            Switches the processor to Flat - Model                 ***
  200.  ***                                                                   ***
  201.  *************************************************************************
  202. }
  203.  
  204. function multitasker_active : boolean; far; external;
  205. {
  206.  *************************************************************************
  207.  ***                                                                   ***
  208.  ***   Checks whether a Multitasker such as QEMM or EMM386 is active   ***
  209.  ***                                                                   ***
  210.  *************************************************************************
  211. }
  212.  
  213. procedure Rmem_read(source:longint; destination:pointer;length:word);
  214. {
  215.  *************************************************************************
  216.  ***                                                                   ***
  217.  ***      Copies a block from RMEM to RAM                              ***
  218.  ***                                                                   ***
  219.  *************************************************************************
  220. }
  221. begin
  222.  if source + length < Rmem_Max then begin
  223.    Segm:=seg(destination^);
  224.    Offs:=ofs(destination^);
  225.    inc(Segm,Offs div 16);
  226.    Offs:=Offs mod 16;
  227.    inc(source,Mbyte1);
  228.    mem_read(source,Offs,Segm,length);
  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;destination:longint;length:word);
  238. {
  239.  *************************************************************************
  240.  ***                                                                   ***
  241.  ***       Copies a block from RAM to RMEM                             ***
  242.  ***                                                                   ***
  243.  *************************************************************************
  244. }
  245. begin
  246.  if destination+length < 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(destination,MByte1);
  252.    mem_write(destination, Offs,Segm,length);
  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.  ***         Checks whether enough memory is available                 ***
  266.  ***                                                                   ***
  267.  *************************************************************************
  268. }
  269. var xmsfree,mainfree : word;
  270. begin;
  271.   { Get Free XMS - memory }
  272.   xmsfree := xms_free;
  273.   { Get Main Memory }
  274.   mainfree := memavail div 1024;
  275.   { Message, if not enough free memory }
  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.  ***        A simplified Getmem-Procedure for 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.  ***        Exit-Procedure of RMEM, MUST be called !                   ***
  309.  ***                                                                   ***
  310.  *************************************************************************
  311. }
  312. begin;
  313.   { unlock block }
  314.   XMS_unlock(My_XmsHandle);
  315.   { Free memory }
  316.   Freemem_XMS(My_XmsHandle);
  317. end;
  318.  
  319. procedure enable_Realmem(Min : word);
  320. {
  321.  *************************************************************************
  322.  ***                                                                   ***
  323.  ***               Switches to RMEM - Mode                             ***
  324.  ***    There must be "MIN" KB free XMS-Memory available !             ***
  325.  ***                                                                   ***
  326.  *************************************************************************
  327. }
  328. begin
  329.  { Check for Multitasker ... }
  330.  if multitasker_active 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.  { XMS driver installed ?  }
  338.  if not XMS_available 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.  { Allocate required memory }
  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.  { Get physical Start position }
  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.  { Enable }
  365.  Enable_4Giga;
  366. end;
  367.  
  368. begin;
  369.   Check_for_XMS;
  370.   Rmem_Max := XMS_Free;
  371. end.
  372.