{

 ****************************************************************************
 ***                   ABACUS'  "PC UNDERGROUND"                          ***
 ***                  ================================                    ***
 ***                                                                      ***
 ***                  Unit for using the Flat-Model                       ***
 ***                                                                      ***
 *** The unit makes routines available, with which the entire memory      ***
 *** of the PC can be accessed in Real mode.                              ***
 *** A Memory-Manager such as EMM386 or QEMM CANNOT be installed.         ***
 *** HIMEM.SYS is required !                                              ***
 ***                                                                      ***
 *** Author          : Boris Bertelsons  (InspirE)                        ***
 *** Filename        : RMEM.PAS                                           ***
 *** Last Update     : 04/28/94                                           ***
 *** Version         : 1.0                                                ***
 *** Compiler        : Turbo Pascal 6.0 and above                         ***
 ****************************************************************************

}
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 Entry 0 (null segment)}
  $FF,$FF,$00,$00,$00,$92,$CF,$FF);       {GDT Entry 1 (seg 0, limit 4Gigabytes)}

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_read(source:longint; destination:pointer;length:word);
procedure Rmem_write(source:pointer;destination:longint;length:word);


implementation

uses dos;

TYPE XMSHandle = word;

     XMS_Copyblock = Record     { Required for copy routines }
       Size     : longint;
       Q_Handle : Word;
       Q_Offset : pointer;
       Z_Handle : Word;
       Z_Offset : pointer;
     end;

VAR XMS_Available    : boolean;  { TRUE, if XMS available }
    XMST             : pointer;  { Driver - Entry point address }
    XMS_Version      : word;     { Version of XMS driver }
    XC               : XMS_Copyblock;
    xms_free         : longint;
    error            : byte;
    My_XmsHandle     : XmsHandle;
    Xms_startposi    : longint;
    Old_ExitprocRmem : pointer;


function XMS_free1 : longint;
var xms_in_kb      : word;
    xms_long       : longint;
begin;
  asm
    mov ax,0800h                 { 8 = Get free memory }
    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 = Allocate memory area }
    mov dx,bsize
    call dword ptr [XMST]
    cmp ax,1
    jne @Error_GetmemXms
    mov xmsh,dx
    mov Fresult,0
    jmp @End_GetmemXms
@Error_GetmemXMS:
    mov Fresult,bl
@End_GetmemXms:
  end;
  h := xmsh;
  Getmem_Xms := Fresult;
end;

Function Freemem_XMS(H : XMSHandle) : byte;
var fresult : byte;
begin;
  asm                            { A = deallocate memory area }
    mov ax,0a00h
    mov dx,h
    call dword ptr [XMST]
    cmp ax,1
    jne @Error_FreememXms
    mov Fresult,0
    jmp @End_FreememXms
@Error_FreememXms:
    mov Fresult,bl
@End_FreememXms:
  end;
end;

Procedure Check_for_XMS; assembler;
  asm
    mov ax,4300h              { Check whether driver installed }
    int 2Fh
    cmp al,80h
    jne @No_XMSDriver
    mov ax,4310h              { Get entry point address of driver }
    int 2Fh
    mov word ptr XMST + 2,es
    mov word ptr XMST + 0,bx
    xor ax,ax                 { Get version number }
    call dword ptr [XMST]
    cmp  ax,0200h
    jb   @No_XMSDriver     { If version < 2.0 then cancel ! }
    mov  XMS_Version,ax
    mov  XMS_Available,0
@No_XMSDriver:
    mov XMS_Available,1
@End_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 rmemasm.obj}
procedure mem_write(q:longint;zl,zh,l:word); far; external;
{
 *************************************************************************
 ***                                                                   ***
 ***       Copies a block from RAM to RMEM                             ***
 ***                                                                   ***
 *************************************************************************
}

procedure mem_read(q:longint;zl,zh,l:word); far; external;
{
 *************************************************************************
 ***                                                                   ***
 ***      Copies a block from RMEM to RAM                              ***
 ***                                                                   ***
 *************************************************************************
}

procedure Enable_4Giga; far; external;
{
 *************************************************************************
 ***                                                                   ***
 ***            Switches the processor to Flat - Model                 ***
 ***                                                                   ***
 *************************************************************************
}

function multitasker_active : boolean; far; external;
{
 *************************************************************************
 ***                                                                   ***
 ***   Checks whether a Multitasker such as QEMM or EMM386 is active   ***
 ***                                                                   ***
 *************************************************************************
}

procedure Rmem_read(source:longint; destination:pointer;length:word);
{
 *************************************************************************
 ***                                                                   ***
 ***      Copies a block from RMEM to RAM                              ***
 ***                                                                   ***
 *************************************************************************
}
begin
 if source + length < Rmem_Max then begin
   Segm:=seg(destination^);
   Offs:=ofs(destination^);
   inc(Segm,Offs div 16);
   Offs:=Offs mod 16;
   inc(source,Mbyte1);
   mem_read(source,Offs,Segm,length);
  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;destination:longint;length:word);
{
 *************************************************************************
 ***                                                                   ***
 ***       Copies a block from RAM to RMEM                             ***
 ***                                                                   ***
 *************************************************************************
}
begin
 if destination+length < Rmem_Max then begin
   Segm := seg(source^);
   Offs := ofs(source^);
   inc(Segm,Offs div 16);
   Offs := Offs mod 16;
   inc(destination,MByte1);
   mem_write(destination, Offs,Segm,length);
  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);
{
 *************************************************************************
 ***                                                                   ***
 ***         Checks whether enough memory is available                 ***
 ***                                                                   ***
 *************************************************************************
}
var xmsfree,mainfree : word;
begin;
  { Get Free XMS - memory }
  xmsfree := xms_free;
  { Get Main Memory }
  mainfree := memavail div 1024;
  { Message, if not enough free memory }
  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;
{
 *************************************************************************
 ***                                                                   ***
 ***        A simplified Getmem-Procedure for 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;
{
 *************************************************************************
 ***                                                                   ***
 ***        Exit-Procedure of RMEM, MUST be called !                   ***
 ***                                                                   ***
 *************************************************************************
}
begin;
  { unlock block }
  XMS_unlock(My_XmsHandle);
  { Free memory }
  Freemem_XMS(My_XmsHandle);
end;

procedure enable_Realmem(Min : word);
{
 *************************************************************************
 ***                                                                   ***
 ***               Switches to RMEM - Mode                             ***
 ***    There must be "MIN" KB free XMS-Memory available !             ***
 ***                                                                   ***
 *************************************************************************
}
begin
 { Check for Multitasker ... }
 if multitasker_active 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;
 { XMS driver installed ?  }
 if not XMS_available 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;
 { Allocate required memory }
 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;
 { Get physical Start position }
 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;
 { Enable }
 Enable_4Giga;
end;

begin;
  Check_for_XMS;
  Rmem_Max := XMS_Free;
end.
