(*
/*

CLASS {NATIVE_Memory_mapping|_Delphi},
UNTESTED, NATIVE:

IMPORT: {{Standard}}, {{Files}} .
IMPORT, ANYWAY: {Memory_mapping} .

NATIVE: "uses NATIVE_Memory_mapping {$IFnDEF LINUX} , Windows {$ENDIF}" .

NATIVE: "///COPY NATIVE_Memory_mapping.*" .



*/
*)
unit NATIVE_Memory_mapping;

interface

uses {$IFDEF LINUX} BaseUnix, Unix, {$ELSE} Windows, {$ENDIF} AL4
	 {$IFDEF KOL} , KOL {$ELSE}, Classes, SysUtils {$ENDIF};

var All_mmaps: {$IFDEF KOL} PList {$ELSE} TList {$ENDIF} ;

type
	{$IFDEF KOL} PMMap = ^TMMap; {$ENDIF}
	TMMap = {$IFDEF KOL} object(TObj) {$ELSE} class {$ENDIF}
	public
		Filename: {$IFDEF FPC} Str {$ELSE} String {$ENDIF};
		Can_write: Boolean;
		File_handle: {$IFDEF LINUX} cint {$ELSE} THandle {$ENDIF};
		Mapping_handle: THandle;
		Max_size: Integer;
		procedure Init_mapping;
		destructor Destroy; {$IFDEF KOL} virtual; {$ELSE} override; {$ENDIF}
	public
		Mapped_ptr: PByte;
		Mapped_from: Integer;
		Mapped_offset: Integer;
		Mapped_size: Integer;
		function Map(From: Integer; Size: Integer): PByte;
		procedure Unmap;
	end;

function Get_mmap_size(H: Integer): Integer;
function Get_mmap_bytes(H: Integer; Offset: Integer; Dest: DynAByte): Integer;
function Put_mmap_bytes(H: Integer; Offset: Integer; Source: DynAByte): Integer;

implementation

procedure TMMap.Init_mapping;
var access: DWORD;
begin
	Mapping_handle := INVALID_HANDLE_VALUE;
	{$IFDEF LINUX}
		access = O_RdOnly or O_Creat or O_NonBlock;
		if Can_write then access := O_RdWr or O_Creat or O_NonBlock; 
		File_handle := fpOpenFile(Filename, access);
	{$ELSE}
		access := GENERIC_READ;
		if Can_write then access := GENERIC_READ or GENERIC_WRITE;
		File_handle := CreateFile(PChar(String(Filename)), 
			access,
			FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE,
			nil,
			OPEN_ALWAYS,
			FILE_ATTRIBUTE_NORMAL,
			0);
		/////////////////////////////////////////////////////////////////////
		//writeln('create file ' + Filename + ' --> ' + IntToStr(File_handle)
		//+ ',ok=' + IntToStr(Integer((File_handle <> INVALID_HANDLE_VALUE))));
		/////////////////////////////////////////////////////////////////////
		if File_handle = INVALID_HANDLE_VALUE then Exit;
		access := PAGE_READONLY;
		if Can_write then access := PAGE_READWRITE;
		Mapping_handle := CreateFileMapping(
			File_handle,
			nil,
			access,
			0,
			Max_size,
			nil); 
		//////////////////////////////////////////////////////////
		//writeln('Created mapping file: ' + IntToStr(File_handle) +
		//	', GetLastError=' + IntToStr(GetLastError()));
	{$ENDIF}
end;

function TMMap.Map(From: Integer; Size: Integer): PByte;
var access: DWORD;
begin
	if (Mapped_from = From) and (Mapped_size = size) then begin
		Result := Mapped_ptr; Exit;
	end;
	Unmap;
	Mapped_from := From;
	Mapped_from := Mapped_from and not 65535;
	Mapped_offset := From - Mapped_from; 
	Mapped_size := Size + Mapped_offset;
	Result := nil;
	if (Mapped_from < 0) or (Mapped_size = 0) then Exit;
	{$IFDEF LINUX}
		access := PROT_READ;
		if Can_write then access := PROT_READ or PROT_WRITE;
		Result := FpMMap(nil,
			Size,
			access,
			MAP_SHARED,
			File_handle,
			Mapped_from);
	{$ELSE}
		access := FILE_MAP_READ;
		//if Can_write then access := FILE_MAP_ALL_ACCESS; // FILE_MAP_WRITE;
		if Can_write then access := FILE_MAP_READ or FILE_MAP_WRITE;
		Mapped_ptr := MapViewOfFile(Mapping_handle,
			access,
			0,
			Mapped_from,
			Mapped_size);
		Result := Mapped_ptr;
	{$ENDIF}
	if Result = nil then begin
		/////////////////////////////////////////////////////////////
        //writeln('Can not MapViewOfFile(' + IntToStr(Mapping_handle) +
        //'), offset=' + IntToStr(From) + ', Len=' + IntToStr(Size) +
        //', GetLastError = ' + IntToStr(GetLastError()));
		//////////////////////// 
		Unmap;
	end;
end;

procedure TMMap.Unmap;
begin
	if Mapped_ptr <> nil then
	begin 
		{$IFDEF LINUX}
			FpMUnMap(Mapped_from, Mapped_size);
		{$ELSE}
			UnmapViewOfFile(Mapped_ptr);
		{$ENDIF}
	end;
	Mapped_ptr := nil;
	Mapped_from := -1;
	Mapped_size := 0;
end;

destructor TMMap.Destroy;
begin
	Unmap;
	{$IFDEF LINUX}
		fpClose(File_handle);
	{$ELSE}
		if Mapping_handle <> INVALID_HANDLE_VALUE then
			CloseHandle(Mapping_handle);
		if File_handle <> INVALID_HANDLE_VALUE then
			CloseHandle(File_handle);
	{$ENDIF}
	inherited;
end;

function Get_mmap_size(H: Integer): Integer;
var mmap: {$IFDEF KOL} PMMap {$ELSE} TMMap {$ENDIF} ;
begin
	Result := 0;
	if (H < 0) or (All_mmaps{$IFDEF KOL}.Items{$ENDIF}[H]=nil) then Exit;
	mmap := {$IFDEF FPC} TMMap {$ENDIF} (All_mmaps{$IFDEF KOL}.Items{$ENDIF}[H]);
	RESULT := GetFileSize(mmap.File_handle, nil);
end;

function Get_mmap_bytes(H: Integer; Offset: Integer; Dest: DynAByte): Integer;
var mmap: {$IFDEF KOL} PMMap {$ELSE} TMMap {$ENDIF} ;
var P: PByte;
var i: Integer;
begin
	RESULT := 0;
	if (H < 0) or (All_mmaps{$IFDEF KOL}.Items{$ENDIF}[H]=nil) then Exit;
	mmap := {$IFDEF FPC} TMMap {$ENDIF} (All_mmaps{$IFDEF KOL}.Items{$ENDIF}[H]);
	P := mmap.Map(Offset, Dest.Count());
	if P = nil then Exit;
	try
		inc(P, mmap.Mapped_offset);
		for i := 0 to Dest.Count()-1 do
		begin
			Dest.SetBytes(i, P^);
			inc(p);
			inc(RESULT);
		end;
	except
        //writeln('*** Get failed');
	end;
end;

function Put_mmap_bytes(H: Integer; Offset: Integer; Source: DynAByte): Integer;
var mmap: {$IFDEF KOL} PMMap {$ELSE} TMMap {$ENDIF} ;
var P: PByte;
var i, b: Integer;
begin
	RESULT := 0;
	if (H < 0) or (All_mmaps{$IFDEF KOL}.Items{$ENDIF}[H]=nil) then Exit;
	mmap := {$IFDEF FPC} TMMap {$ENDIF} (All_mmaps{$IFDEF KOL}.Items{$ENDIF}[H]);
	P := mmap.Map(Offset, Source.Count());
	if P = nil then Exit;
    //writeln('mapped(w): from=' + IntToStr(mmap.Mapped_from) +
    //    ', offset=' + IntToStr(mmap.Mapped_offset) +
    //    ', len=' + IntToStr(mmap.Mapped_size));
	try
		inc(P, mmap.Mapped_offset);
		for i := 0 to Source.Count()-1 do
		begin
			b := Source.GetBytes(i);
			P^ := b;
			inc(P);
			inc(RESULT);
			/////////////////////
			//write('[' + IntToStr(i) + ']<<' + Char(b) + '<' + IntToStr(b) + '> ');
		end;
        //if Result = 0 then
        //    writeln('write count=0 though Source[].Count=' + IntToStr(Source.Count())
        //    + ' and mapped was=' + IntToStr(mmap.Mapped_size) );
	except
        //writeln('*** Put failed');
	end;
end;

end.

(*
/*

FUNCTION Create_memory_mapping(
STR File|_path, BOOL Can_w|rite, INT Max|imum_size) ==> INT,
	NATIVE : @
   "var i: Integer;"
   "var mmap: {$IFDEF KOL} PMMap {$ELSE} TMMap {$ENDIF} ;"
   ""     
   "if All_mmaps=nil then"
   "    All_mmaps := {$IFDEF KOL} NewList {$ELSE} TList.Create {$ENDIF} ;"
   "Result := -1;"
   "for i := 0 to All_mmaps.Count-1 do"
   "    if All_mmaps{$IFDEF KOL}.Items{$ENDIF}[i]=nil then begin"
   "        Result := i; break;"
   "    end;"
   "if Result < 0 then begin"
   "    Result := All_mmaps.Count;"
   "    All_mmaps.Add(nil) ;"
   "end;"
   "{$IFDEF KOL}"
   "	new(mmap, Create);"     
   "    All_mmaps.Items[Result] := mmap;"
   "{$ELSE}"
   "    All_mmaps[Result] := TMMap.Create;"
   "{$ENDIF}"
   "mmap := {$IFDEF FPC} TMMap {$ENDIF} "
   "		(All_mmaps{$IFDEF KOL}.Items{$ENDIF}[Result]);"
   "mmap.Filename := X_File;"
   "mmap.Can_write := X_Can_w;"
   "mmap.Max_size := X_Max;"
   "mmap.Init_mapping();" .
    
FUNCTION Close_memory_mapping(INT Handle|_mapping),
	NATIVE : @
	"var mmap: {$IFDEF KOL} PMMap {$ELSE} TMMap {$ENDIF} ;"
	"mmap := {$IFDEF FPC} TMMap {$ENDIF} "
	"	(All_mmaps{$IFDEF KOL}.Items{$ENDIF}[X_Handle]);"
	"mmap.Unmap();"
	"if mmap.Mapping_handle <> INVALID_HANDLE_VALUE then begin"
	"	//writeln('close mapping: ' + IntToStr(mmap.Mapping_handle));"     
	"	CloseHandle( mmap.Mapping_handle);"
	"end;"     
	"mmap.Mapping_handle := INVALID_HANDLE_VALUE;"
	"if mmap.File_handle <> INVALID_HANDLE_VALUE then begin"
	"	CloseHandle( mmap.File_handle);"     
	"end;"     
    "mmap.Free;"
	"All_mmaps{$IFDEF KOL}.Items{$ENDIF}[X_Handle] := nil;" .
    
CONST STR :
	NATIVE_Memory_mapping_import = @
	"uses "
	"NATIVE_Memory_mapping" 
	
	NATIVE_All_Memory_mappings = ""     
	
	NATIVE_Memory_mapping_size = @
	"RESULT := Get_mmap_size(X_Handle);"
	
	NATIVE_Memory_mapping_get = @
	"RESULT := Get_mmap_bytes(X_Handle, X_Offset, X_Dest);"
	
	NATIVE_Memory_mapping_put = @
	"RESULT := Put_mmap_bytes(X_Handle, X_Offset, X_Source);"
	
	.

END

*/
*)




