implementation module StdDynamicSharedBuffer

import StdEnv

import memory_mapped_files

import memory;

import StdDynamicLowLevelInterface

instance BinaryDynamicIO (!Int,!*StdDynamicSharedBufferInfo)
where
	bd_readi (ptr,mem)
		# (word,mem)
			= readWord1 ptr mem
		= (True,word,(ptr + 4,mem))

	bd_reads (ptr,mem) n_characters
		# string
			= createArray n_characters ' '
		# (ptr,string,mem)
			= bd_reads_loop 0 ptr string mem
		= (string,(ptr,mem))
	where
		// kan veel efficienter
		bd_reads_loop i ptr string mem
			| i == n_characters
				= (ptr,string,mem)
			# (c,mem)
				= readByte1 ptr mem
			= bd_reads_loop (inc i) (inc ptr) {string & [i] = toChar c} mem
			
	bd_seek (_,buffer=:{view}) offset FSeekSet
		= (True,(view + offset ,buffer))
		
	bd_delta_fp file
		= (0,file)
		
	bd_freadsubstring i n s (ptr,mem) 
//		= abort "StdDynamicSharedBuffer; bd_freadsubstring"; //freadsubstring i n s f

		= bd_freadsubstring_loop i (i+n-1) s ptr mem
	where 
		bd_freadsubstring_loop i limit s ptr mem
			| i == limit
				= (n,s,(ptr,mem))
			# (c,mem)
				= readByte1 ptr mem
			= bd_freadsubstring_loop (inc i) limit {s & [i] = toChar c} (inc ptr) mem

/*
	/*
	Reads n characters from a text or data file, which are returned in the string s
	at positions i..i+n-1. If the file doesn't contain n characters the file will
	be read to the end of the file, and the part of the string s that could not be
	read will not be changed. The number of characters read, the modified string
	and the file are returned.
	*/
freadsubstring i n s f

*/

:: *StdDynamicSharedBufferInfo
	= {
		hfile	:: !HFILE
	,	hmap	:: !HANDLE
	,	view	:: !Int
	};

// ATTENTION:
// The first 2 words of a dynamic are overwritten by a pointer to the string descriptor and
// the length of the string. The header_size 
CreateSharedBufferFromFile2 :: !Int !String -> (Bool,(!Int,!*StdDynamicSharedBufferInfo),(!Int,!Int))
CreateSharedBufferFromFile2 dynamic_rts_process_handle file_name
	// open file
	# (file_handle,st)
		= CreateFile (file_name +++ "\0") GENERIC_READ FILE_SHARE_READ NULL OPEN_EXISTING  FILE_ATTRIBUTE_NORMAL 0 initialState
	| file_handle == INVALID_HANDLE_VALUE
		= abort "CreateSharedBuffer: CreateFile failed"
	
	# (file_size,st)
		= GetFileSize file_handle NULL st
	| file_size == 0xFFFFFFFF 
		= abort "CreateSharedBuffer: GetFileSize"	
	
	// create file mapping
	# (file_mapping_handle,st)
		= CreateFileMapping file_handle NULL PAGE_READONLY 0 0 NULL st
	| file_mapping_handle == 0
		= abort ("CreateSharedBuffer: CreateFileMapping failed" +++ toString GetLastError)		

	// map view of file
	# (view,st)
		= MapViewOfFile file_mapping_handle FILE_MAP_READ 0 0 0 st
	| view == 0
		= abort "CreateSharedBuffer: MapViewOfFile"	

	# (current_process_handle,st)
		= GetCurrentProcess st

	// duplicate handle to that string to dynamic rts
	# (a,st)
		= address_of_buffer st;
	# (bool,st)
		= DuplicateHandle current_process_handle file_mapping_handle dynamic_rts_process_handle (Ptr a) 0 0 DUPLICATE_SAME_ACCESS st
	| bool == 0
		= abort ("copy_to_dynamic_rts: failure of DuplicateHandle" +++ toString GetLastError)
	# (file_mapping_handle_in_server,st)
		= readWord1 a st;

	# stdDynamic_shared_buffer_info
		= {
			hfile	= file_handle
		,	hmap	= file_mapping_handle
		,	view	= view
		};		
	# file
		= (0,stdDynamic_shared_buffer_info)
	| CloseST st
		= (True,file,(file_mapping_handle_in_server,file_size));
//	= (True,file,toString file_mapping_handle_in_server +++ "\n" +++ toString file_size)

CreateSharedBufferFromFile :: !Int !String -> (Bool,(!Int,!*StdDynamicSharedBufferInfo),!String)
CreateSharedBufferFromFile dynamic_rts_process_handle file_name
	#! (ok,file,(file_mapping_handle_in_server,file_size))
		= CreateSharedBufferFromFile2 dynamic_rts_process_handle file_name;
	= (True,file,toString file_mapping_handle_in_server +++ "\n" +++ toString file_size);

OpenExistingSharedBuffer2 :: (!Int,!Int) -> (Bool,(!Int,!*StdDynamicSharedBufferInfo))
OpenExistingSharedBuffer2 (file_mapping_handle,s_buffer)
	= OpenExistingSharedBuffer file_mapping_handle s_buffer;

OpenExistingSharedBuffer :: !Int !Int -> (Bool,(!Int,!*StdDynamicSharedBufferInfo))
OpenExistingSharedBuffer file_mapping_handle s_buffer
	# (view,st)
		= MapViewOfFile file_mapping_handle FILE_MAP_READ 0 0 s_buffer initialState
	| view == 0
		= abort ("OpenExistingSharedBuffer: MapViewOfFile failed" +++ toString GetLastError)
		
	# stdDynamic_shared_buffer_info
		= {
			hfile	= 0
		,	hmap	= file_mapping_handle
		,	view	= view
		};
	# file
		= (0,stdDynamic_shared_buffer_info)
	= (True,file);
	
CloseExistingSharedBuffer :: !(!Int,!*StdDynamicSharedBufferInfo) -> !Bool
CloseExistingSharedBuffer (_,{hmap,view})
	# st
		= initialState

	# (bool,st)
		= UnmapViewOfFile view st
	| bool == 0
		= abort ("get_tables_from_dynamic; could not close view" +++ toString GetLastError);
		
	# (bool,st)
		= CloseHandle hmap st
	| bool == 0
		= abort "get_tables_from_dynamic; could not close view"
					
	= CloseST st
	
CloseSharedBufferFromFile :: (!Int,!*StdDynamicSharedBufferInfo) -> !Bool
CloseSharedBufferFromFile (_,{hfile,hmap,view})
	#! (bool,st)
		= UnmapViewOfFile view initialState
	| bool == 0
		= abort "CloseSharedBufferFromFile; failure of CloseSharedBufferFromFile"

	# st = initialState		
	# (bool,st)
		= CloseHandle hmap st
	| bool == 0
		= abort "CloseSharedBufferFromFile; failure of CloseHandle (1)"
		
	# (bool,st)
		= CloseHandle hfile st
	| bool == 0
		= abort "CloseSharedBufferFromFile; failure of CloseHandle (2)"

	= CloseST st

CreateSharedBufferFromPageFile :: !Int !String -> (Bool,(!Int,!*StdDynamicSharedBufferInfo),!String)
CreateSharedBufferFromPageFile dynamic_rts_process_handle dynamic_as_string
	# file_size
		= size dynamic_as_string
		
	// create file mapping
	# (file_mapping_handle,st)
		= CreateFileMapping 0xFFFFFFFF NULL PAGE_READWRITE 0 file_size NULL initialState
	| file_mapping_handle == 0
		= abort ("CreateSharedBufferFromPageFile: CreateFileMapping failed" +++ toString GetLastError)		
	
	// map view of file
	# (view,st)
		= MapViewOfFile file_mapping_handle FILE_MAP_WRITE 0 0 file_size st
	| view == 0
		= abort "CreateSharedBufferFromPageFile: MapViewOfFile failed"

	# (current_process_handle,st)
		= GetCurrentProcess st

	// duplicate handle to that string to dynamic rts
	# (a,st)
		= address_of_buffer st;
	# (bool,st)
		= DuplicateHandle current_process_handle file_mapping_handle dynamic_rts_process_handle (Ptr a) 0 0 DUPLICATE_SAME_ACCESS st
	| bool == 0
		= abort "copy_to_dynamic_rts: failure of DuplicateHandle"
	# (file_mapping_handle_in_server,st)
		= readWord1 a st;
		
	# st
		= copy_string 0 file_size dynamic_as_string view st
	| CloseST st
//		= abort (toString (call_debugger view));


	# stdDynamic_shared_buffer_info
		= {
			hfile	= 0
		,	hmap	= file_mapping_handle
		,	view	= view
		};		
	# file
		= (0,stdDynamic_shared_buffer_info)
//	| CloseST st
	= (True,file,toString file_mapping_handle_in_server +++ "\n" +++ toString file_size)		
where
	copy_string :: !Int !Int !String !Int !ST -> !ST;
	copy_string i limit dynamic_as_string view st
		#! rest
			= limit mod 4
		#! st
			= copy_string_per_word i (limit - rest) dynamic_as_string view st
		#! st
			= copy_string_per_byte (limit-rest) limit dynamic_as_string view st
		= st		
	where
		copy_string_per_word :: !Int !Int !String !Int !ST -> !ST;
		copy_string_per_word i limit dynamic_as_string view st
			| i >= limit
				= st 
			# v
				= FromStringToInt dynamic_as_string i
			= copy_string_per_word (i + 4) limit dynamic_as_string view (writeWord1 v (view + i) st)
			
			
		copy_string_per_byte :: !Int !Int !String !Int !ST -> !ST;
		copy_string_per_byte i limit dynamic_as_string view st
			| i == limit
				= st
			= copy_string_per_byte (inc i) limit dynamic_as_string view  (writeByte1 dynamic_as_string.[i] (view + i) st)
		


CloseSharedBufferFromPageFile :: (!Int,!*StdDynamicSharedBufferInfo) -> !Bool
CloseSharedBufferFromPageFile (_,{hmap,view})
	#! (bool,st)
		= UnmapViewOfFile view initialState
	| bool == 0
		= abort "CloseSharedBufferFromFile; failure of CloseSharedBufferFromFile"

	# st = initialState		
	# (bool,st)
		= CloseHandle hmap st
	| bool == 0
		= abort "CloseSharedBufferFromFile; failure of CloseHandle (1)"
		
	= CloseST st
	
FromStringToInt :: !String !Int -> !Int
FromStringToInt array i
	= (toInt v0)+(toInt v1<<8)+(toInt v2<<16)+(toInt v3<<24)
where
	v0= array.[i]
	v1
		= array.[i+1]
	v2 
		= array.[i+2]
	v3  
		= array.[i+3]

/*
CreateSharedBufferFromPageFile :: !String -> (Bool,(!Int,!*{#Char}),!String,!*StdDynamicSharedBufferInfo)
CreateSharedBufferFromPageFile string
	# s_buffer
		= size string
		
	// create shared clean string
	# (file_mapping_handle,st)
		= CreateFileMapping 0xFFFFFFFF NULL PAGE_READWRITE 0 s_buffer (Ptr "zomaar\0") initialState
	| file_mapping_handle == 0
		= abort ("CreateSharedBufferFromPageFile: CreateFileMapping failed" +++ toString GetLastError)		


	# (view,st)
		= MapViewOfFile file_mapping_handle FILE_MAP_WRITE 0 0 s_buffer st
	| view == 0
		= abort "CreateSharedBufferFromPageFile: MapViewOfFile failed"
		
	# (buffer,st)
		= CreateSharedString view s_buffer st
		
	# (current_process_handle,st)
		= GetCurrentProcess st
	# (dynamic_rts_process_handle,st)
		= GetHandleToServer st

	// duplicate handle to that string to dynamic rts
	# (bool,st)
		= DuplicateHandle current_process_handle file_mapping_handle dynamic_rts_process_handle (Ptr (view + 8)) 0 0 DUPLICATE_SAME_ACCESS st
	| bool == 0
		= abort "copy_to_dynamic_rts: failure of DuplicateHandle"
	| CloseST st
	# (handle_to_shared_string_in_dynamic_rts,buffer)
		= FromStringToIntU buffer 0;
		
		
	# buffer 
		= copy_string 8 s_buffer string 0 buffer

/*		
	# (s_buffer,buffer)
		= usize buffer
	| s_buffer <> 0
	
	= abort (toString (call_debugger  view))
*/


	# stdDynamic_shared_buffer_info
		= {
			hfile	= 0
		,	hmap	= file_mapping_handle
		,	view	= view
		};
	= (True,(0,buffer),toString handle_to_shared_string_in_dynamic_rts +++ "\n" +++ toString s_buffer,stdDynamic_shared_buffer_info)
where 
	copy_string i limit src j dest
		| i == limit
			= dest
		= copy_string (inc i) limit src (inc j) {dest & [j] = src.[i] }
		
CloseSharedBufferFromPageFile :: !*StdDynamicSharedBufferInfo -> !Bool
CloseSharedBufferFromPageFile {hmap,view}
/*
	#! (bool,st)
		= UnmapViewOfFile view initialState
	| bool == 0
		= abort "CloseSharedBufferFromFile; failure of CloseSharedBufferFromFile"
*/
	# st = initialState		
	# (bool,st)
		= CloseHandle hmap st
	| bool == 0
		= abort "CloseSharedBufferFromFile; failure of CloseHandle (1)"
	= CloseST st
*/	
call_debugger :: !Int -> !Int
call_debugger _
	= code {
		instruction 204
	}

GetHandleToServer :: !ST -> (!HANDLE,!ST)
GetHandleToServer st
	= (GetHandleToServer2,st)

GetHandleToServer2 :: !HANDLE;
GetHandleToServer2 
	= code {
		ccall GetHandleToServer ":I"
	}
		
FromStringToIntU :: !*{#Char} !Int -> (!Int,!*{#Char});
FromStringToIntU array i
	#! (v0,array)
		= array![i];
	#! (v1,array)
		= array![i+1];
	#! (v2,array)
		= array![i+2];
	#! (v3,array)
		= array![i+3];
	#! i
		= (toInt v0)+(toInt v1<<8)+(toInt v2<<16)+(toInt v3<<24);
	= (i,array);
	
WriteLong :: !*{#Char} !Int !Int -> !*{#Char};
WriteLong array i v
	= { array & [i] 	= (toChar v)		,	[i+1] = (toChar (v>>8)),
				[i+2]	= (toChar (v>>16))  ,	[i+3] = (toChar (v>>24))};
