Penulis Topik: [Delphi] VirtualMemory Implementasion  (Dibaca 7640 kali)

Offline meong

  • Pro100
  • ****
  • Tulisan: 121
  • Reputation: 203
    • Lihat Profil
[Delphi] VirtualMemory Implementasion
« pada: September 20, 2011, 02:14:20 PM »
Implementasi VirtualMemory buat digunain untuk Emulator / VM (Virtual Machine) anda.

jelasnya tentang virtualMemory baca di
http://www.rohitab.com/discuss/topic/31139-tutorial-paging-memory-mapping-with-a-recursive-page-directory/

Kutip
Windows on 32 bit x86 systems can access up to 4GB of physical memory. This is due to the fact
that the processor’s address bus which is 32 lines or 32 bits can only access address range from
0x00000000 to 0xFFFFFFFF which is 4GB. Windows also allows each process to have its own
4GB logical address space. The lower 2GB of this address space is available for the user mode
process and upper 2GB is reserved for Windows Kernel mode code. How does Windows give 4GB
address space each to multiple processes when the total memory it can access is also limited to
4GB. To achieve this Windows uses a feature of x86 processor (386 and above) known as paging.
Paging allows the software to use a different memory address (known as logical address) than the
physical memory address. The Processor’s paging unit translates this logical address to the physical
address transparently. This allows every process in the system to have its own 4GB logical address
space.

here u go the code

Kode: [Pilih]
{ U_VMemory
Author: Abhe
Description: VirtualMemory Implementasion (ported from Libemu)
Release Date: 20th September 2011
Website: http://cybercoding.wordpress.com/
}
unit U_VMemory;

interface
{$I Build.inc}
uses
Windows, U_VUtils, U_VLog, TypInfo;

type
  PArrayPointer = ^TArrayPointer;
  TArrayPointer = Array [0..1023] of Pointer;
  TSegment = (s_cs, s_ss, s_ds, s_es, s_fs, s_gs);

  TMemRange = record
    id: Char;
    start, Stop : Cardinal;
  end;

  TVMemory = class
  Private
    {Physical Directory Table}
    PDT: Pointer;

    {SegMent}
    ST: Array [TSegment] of DWORD;
    SO: DWORD;
    SC: TSegment;

    MemPoints: Array of DWORD;
    MemRangess: Array of TMemRange;

    Procedure MemoryCheck(addr, len: DWORD; mode:char);
    Function PageAlloc(addr:DWORD):Boolean;
    Function PageDealloc(addr:DWORD):Boolean;
    Procedure Clear;
    Function PageIsAlloc(addr: DWORD):Boolean;
    Function Translate(addr: DWORD):Integer;
  Public
    OnMemPoints: Procedure (addr: DWORD);
    OnMemRangess: Procedure (id, mode: char; addr: DWORD);

    constructor Create;
    Destructor Destroy; override;

    function AllocMemory(var addr: DWORD; Size:DWORD):boolean;
    Procedure DeallocMemory(addr: DWORD; Size:DWORD);

    Function ReadBlock(addr: DWORD; Size:DWORD; dest:Pointer):Integer;
    Function WriteBlock(addr:DWORD; Write:Pointer; Size:DWORD):integer;

    Procedure SelectSegment(s: TSegment);
    Function GetSegMent: TSegment;

    Procedure AddMonitorPoint(addr: DWORD);
    Procedure AddMonitorRange(id:Char; start,Stop: DWORD);
    Procedure ClearMonitorPoint;
    Procedure ClearMonitorRange;
  end;


{$IFDEF VirtualMemory} var  VMemory : TVMemory; {$ENDIF}

type
  TMem = Record
    class function Read<T>(addr:DWORD): T; static;
    class function Write<T>(addr:DWORD; Data:T): Integer; static;
    class function Alloc(var addr:DWORD; Size:DWORD): boolean; static;
    class Procedure Dealloc(addr:DWORD; Size:DWORD); static;
    class Function ReadBlock(addr: DWORD; dest:Pointer; Size:Dword):Integer; static;
    class Function WriteBlock(addr:DWORD; Write:Pointer; Size:DWord):integer; static;
  end;

const
  PAGE_BITS = 12;
  PAGESET_BITS = 10;
  PAGE_SIZE = (1 shl PAGE_BITS);
  PAGESET_SIZE = (1 shl PAGESET_BITS);
  FS_SEGMENT_DEFAULT_OFFSET = $7ffdf000;

implementation

class Function TMem.ReadBlock(addr: DWORD; dest:Pointer; Size:DWORD):Integer;
begin
{$IFDEF VirtualMemory}
  result := VMemory.ReadBlock(addr, Size, dest);
{$ELSE}
  if (Pointer(addr)=nil) then Log('Read UnAllocated Memory %x', lgError, [addr]);
  CopyMemory(dest, Pointer(addr), Size);
  result := Size;
{$ENDIF}
end;

class Function TMem.WriteBlock(addr:DWORD; Write:Pointer; Size:DWORD):integer;
begin
{$IFDEF VirtualMemory}
  result := VMemory.WriteBlock(addr, Write, Size);
{$ELSE}
  if (Pointer(addr)=nil) then Log('Write UnAllocated Memory %x', lgError, [addr]);
  CopyMemory(Pointer(addr), Write, Size);
{$ENDIF}
end;

class function TMem.Read<T>(addr:DWORD): T;
var
  ti: PTypeInfo;
  ds: integer;
  Size:Integer;
begin
  ti := System.TypeInfo(T);
  if assigned(ti) then begin
    ds := GetInlineSize(ti);
    TMem.ReadBlock(addr, @result, ds);
  end;
end;

class function TMem.Write<T>(addr:DWORD; Data:T): Integer;
var
  ti: PTypeInfo;
  ds: integer;
  dt: Pointer;
begin
  result := -1;
  ti := System.TypeInfo(T);
  if assigned(ti) then begin
    ds := GetInlineSize(ti);
    result := TMem.WriteBlock(addr, @Data, ds);
  end;
end;

class function TMem.Alloc(var addr:DWORD; Size:DWORD): boolean;
begin
{$IFDEF VirtualMemory}
  result := VMemory.AllocMemory(Addr, Size);
{$ELSE}
  addr := Cardinal(AllocMem(Size));
  result := true;
{$ENDIF}
end;

class Procedure TMem.Dealloc(addr:DWORD; Size:DWORD);
begin
{$IFDEF VirtualMemory}
  VMemory.DeallocMemory(Addr, Size);
{$ELSE}
  FreeMem(Pointer(addr), Size);
{$ENDIF}
end;

function PAGESET(x: DWORD): DWORD;
begin
  result := ((x) shr (PAGESET_BITS + PAGE_BITS));
end;

function PAGE(x: DWORD): DWORD;
begin
  result := (((x) shr PAGE_BITS) and ((1 shl PAGESET_BITS) - 1));
end;

function OFFSET(x: DWORD): DWORD;
begin
  result := (((1 shl PAGE_BITS) - 1) and (x));
end;

constructor TVMemory.Create;
begin
  inherited create;
  PDT := AllocMem((1 shl (32 - PAGE_BITS - PAGESET_BITS))*4);
  ST[s_fs] := FS_SEGMENT_DEFAULT_OFFSET;
  SO := 0;
end;

Destructor TVMemory.Destroy;
begin
  Clear;
  inherited Destroy;
end;

Procedure TVMemory.Clear;
var
  i,j: DWORD;
  PT: Pointer;
  PG: Pointer;
begin
  if (PDT=nil) then exit;

  for i := 0 to (1 shl (32 - PAGE_BITS - PAGESET_BITS)) -1 do begin

    {Page Directory Traversal}
    if PInteger(DWORD(PDT)+i*4)^=0 then continue;
    PT := Pointer(PInteger(DWORD(PDT)+i*4)^);
    if (PT=nil) then begin
      Log('Allocated But Nil [Table: %d = %x]', lgerror, [i, DWORD(PT)]);
      continue;
    end;

    {Page Table Traversal}
    for j := 0 to PAGESET_SIZE -1 do begin
      if PInteger(DWORD(PT)+j*4)^=0 then continue;
      PG := Pointer(PInteger(DWORD(PT)+j*4)^);
      if (PG=nil) then begin
        Log('Allocated But Nil [Page: %d = %x]', lgerror, [i, DWORD(PG)]);
        continue;
      end;
      Freemem(PG, PAGE_SIZE);
    end;

    Freemem(PT, PAGESET_SIZE*4);
  end;
  Freemem(PDT, (1 shl (32 - PAGE_BITS - PAGESET_BITS))*4);
end;

Function TVMemory.PageAlloc(addr:DWORD):Boolean;
var
  PT:Pointer;
  PG:Pointer;
begin
  result := false;

  {Alloc PageTables}
  if PInteger(DWORD(PDT)+PAGESET(addr)*4)^=0 then begin
    PT := AllocMem(PAGESET_SIZE*4);
    PInteger(DWORD(PDT)+PAGESET(addr)*4)^ := DWORD(PT);
  end;

  {Alloc Page}
  PT := Pointer(PInteger(DWORD(PDT)+PAGESET(addr)*4)^);
  if PInteger(DWORD(PT)+PAGE(addr)*4)^=0 then begin
    PG := AllocMem(PAGE_SIZE);
    PInteger(DWORD(PT)+PAGE(addr)*4)^ := DWORD(PG);
    result := true;
  end;
end;

Function TVMemory.PageIsAlloc(addr: DWORD):Boolean;
var
  PT:Pointer;
begin
  result := false;
  if PInteger(DWORD(PDT)+PAGESET(addr)*4)^=0 then exit;
  PT := Pointer(PInteger(DWORD(PDT)+PAGESET(addr)*4)^);
  if (PT=nil) then exit;
  result := PInteger(DWORD(PT)+PAGE(addr)*4)^ <> 0;
end;

Function TVMemory.Translate(addr: DWORD):Integer;
var
  PT:Pointer;
  base:DWORD;
begin
  result := 0;
  if PInteger(DWORD(PDT)+PAGESET(addr)*4)^=0 then exit;
  PT := Pointer(PInteger(DWORD(PDT)+PAGESET(addr)*4)^);
  if (PT=nil) then exit;
  base := PInteger(DWORD(PT)+PAGE(addr)*4)^;
  result := base+OFFSET(addr);
end;

Function TVMemory.PageDealloc(addr:DWORD):Boolean;
var
  PT:Pointer;
  PG: Pointer;
begin
  result := false;
  if PInteger(DWORD(PDT)+PAGESET(addr)*4)^=0 then exit;
  PT := Pointer(PInteger(DWORD(PDT)+PAGESET(addr)*4)^);
  if (PT=nil) then exit;
  PG := Pointer(PInteger(DWORD(PT)+PAGE(addr)*4)^);
  FreeMem(PG, PAGE_SIZE);
  PInteger(DWORD(PT)+PAGE(addr)*4)^ := 0;
  result := true;
end;

Procedure TVMemory.DeallocMemory(addr: DWORD; Size:DWORD);
var
  i, pages : Cardinal;
begin
  if Size=0 then exit;
  pages := Size div PAGE_SIZE;
  if( Size mod PAGE_SIZE <> 0 ) then inc(pages);
  for i:=0 to pages -1 do PageDealloc(addr + i * PAGE_SIZE);
end;

function TVMemory.AllocMemory(var addr: DWORD; Size:DWORD): Boolean;
var
  i, pages : DWORD;
begin
  result := false;
  if Size=0 then exit;
  addr := $00200000;
  pages := Size div PAGE_SIZE;
  if( Size mod PAGE_SIZE <> 0 ) then inc(pages);
  while 1=1 do begin
    for i:=0 to pages -1 do begin
      if not PageIsAlloc(addr + i * PAGE_SIZE) then break;
    end;
    if i=pages-1 then begin
      for i:=0 to pages -1 do begin
        if not PageAlloc(addr + i * PAGE_SIZE) then exit;
      end;
      result := true;
      exit;
    end;
    addr := addr +  PAGE_SIZE;
  end;
end;

Function TVMemory.ReadBlock(addr: DWORD; Size:DWORD; dest:Pointer): integer;
var
  address: DWORD;
  oaddr: DWORD;
  cb: DWORD;
begin
  result := -1;

  oaddr := addr;
  addr := addr + SO;
  MemoryCheck(addr, Size, 'r');
  address := translate(addr);
  if ( address = 0 ) and (Pointer(address) = nil) then begin
    Log('accessing %x', lgError, [addr]);
    exit;
  end;

  if (OFFSET(addr) + Size <= PAGE_SIZE) then begin
    CopyMemory(dest, Pointer(address), Size);
    result := Size;
  end else begin
    cb := PAGE_SIZE - OFFSET(addr);
    CopyMemory(dest, Pointer(address), cb);
    result := result + readblock(oaddr + cb, Size - cb, Pointer(DWord(dest)+cb));
  end;
end;

Function TVMemory.WriteBlock(addr:DWORD; Write:Pointer; Size:DWORD):integer;
var
  address: DWORD;
  oaddr: DWORD;
  cb: DWORD;
begin
  result := -1;

  oaddr := addr;
  addr := addr + SO;
  MemoryCheck(addr, Size, 'w');

  if( addr < $1000 ) then begin
    Log('accessing %x', lgError, [addr]);
    exit;
  end;

  address := translate(addr);
  if ( address = 0 ) and (Pointer(address) = nil) then begin
    if not PageAlloc(addr) then exit;
    address := translate(addr);
  end;

  if (OFFSET(addr) + size <= PAGE_SIZE) then begin
    copymemory(Pointer(address), Write, Size);
    result := Size;
  end else begin
    cb := PAGE_SIZE - OFFSET(addr);;
    copymemory(Pointer(address), Write, Size);
    result := result + WriteBlock(oaddr + cb, Pointer(DWORD(Write)+cb),size - cb);
  end;
end;

Procedure TVMemory.SelectSegment(s: TSegment);
begin
  SC := s;
  SO := ST[s];
end;

Function TVMemory.GetSegMent: TSegment;
begin
  result := SC;
end;

Procedure TVMemory.MemoryCheck(addr, len: DWORD; mode:char);
var
  i: DWORD;
begin
  if (@OnMemPoints<>nil) then begin
    for i:=0 to length(MemPoints)-1 do begin
      if( (MemPoints[i] >= addr) and (MemPoints[i] <= (addr + len) )) then
        OnMemPoints(addr);
    end;
  end;

  if (@OnMemRangess<>nil) then begin
    for i:=0 to length(MemRangess)-1 do begin
      if( (addr >= MemRangess[i].start) and (addr <= MemRangess[i].stop )) then begin
        OnMemRangess(MemRangess[i].id, mode,  addr);
        break;
      end;

      if (addr < MemRangess[i].start) and ( (addr + len) >= MemRangess[i].start) then begin
        OnMemRangess(MemRangess[i].id, mode,  addr);
        break;
      end;
    end;
  end;
end;

procedure TVMemory.AddMonitorPoint(addr: DWORD);
begin
  setlength(MemPoints, length(MemPoints)+1);
  MemPoints[length(MemPoints)-1] := addr;
end;

Procedure TVMemory.AddMonitorRange(id:Char; start,Stop: DWORD);
begin
  setlength(MemRangess, length(MemRangess)+1);
  MemRangess[length(MemRangess)-1].id := id;
  MemRangess[length(MemRangess)-1].start := start;
  MemRangess[length(MemRangess)-1].Stop := Stop;
end;

Procedure TVMemory.ClearMonitorPoint;
begin
   setlength(MemPoints, 0);
end;

Procedure TVMemory.ClearMonitorRange;
begin
  setlength(MemRangess, 0);
end;


{$IFDEF VirtualMemory}
initialization
  VMemory := TVMemory.Create;

finalization
  VMemory.Free;

{$ENDIF}


end.

sample

Kode: [Pilih]
var
  x: Cardinal;
begin
  TMem.Alloc(x, 1);
  TMem.Write<BYTE>(x, $4);
  codesite.Send('x', TMem.Read<Byte>(x));
end.

directlink : http://cybercoding.wordpress.com/2011/09/20/delphi-virtualmemory-implementasion/
« Edit Terakhir: September 21, 2011, 08:31:36 PM oleh meong »