implementation module pdObjectToMem;

// linker
import DLState;
import WriteOptionsFile;

// linker; utilities
import ExtFile;
import ExtInt;

from DynamicLink import ReplyReq, ReplyReqS, MakeNonUnique, ReceiveCodeDataAdr, mwrites, FlushBuffers;

import CommonObjectToDisk;
import LinkerOffsets;
from DynamicLinkerOffsets import Dcompute_imported_library_symbol_offsets;
import IdataSection;

//1.3
from deltaIOState import FileEnv;
//3.1
/*2.0
from deltaIOState import instance FileEnv (IOState s);
0.2*/


// Client <-> Server communication
class SendAddressToClient a
where {
	SendAddressToClient :: !ProcessSerialNumber a !(IOState *s) -> !(IOState *s)
};

//1.3
instance SendAddressToClient !Int
//3.1
/*2.0
instance SendAddressToClient Int
0.2*/
where {
//	SendAddressToClient :: !Int !(IOState *s) -> !(IOState *s);
	SendAddressToClient _ start_addr io
		| ReplyReq start_addr
			= io;
};

//1.3
instance SendAddressToClient !{#Char}
//3.1
/*2.0
instance SendAddressToClient {#Char}
0.2*/
where {
//	SendAddressToClient :: !String !(IOState *s) -> !(IOState *s);
	SendAddressToClient _ s_symbol_addresses io
		| ReplyReqS s_symbol_addresses
			= io;
};

instance SendAddressToClient [Int]
where {
	SendAddressToClient _ symbol_addresses io
		#! s
			= foldl (\s i -> s +++ (FromIntToString i)) "" symbol_addresses;
		| ReplyReqS s
			= io;
};

instance SendAddressToClient (Int,[Int])
where {
	SendAddressToClient _ (id,symbol_addresses) io
		#! encoded_symbol_addresses
			= foldl (\s i -> s +++ (FromIntToString i)) "" symbol_addresses;
		#! encoded_id
			= FromIntToString id;
		| ReplyReqS (encoded_id +++ encoded_symbol_addresses)
			= io;
}; 
// encoding should be separate from sending

instance SendAddressToClient ({#Char},Int,[Int])
where {
	SendAddressToClient _ (string,id,symbol_addresses) io
		#! encoded_symbol_addresses
			= foldl (\s i -> s +++ (FromIntToString i)) "" symbol_addresses;
		#! encoded_id
			= FromIntToString id;
		| ReplyReqS (string +++ encoded_id +++ encoded_symbol_addresses)
			= io;
}; 

instance SendAddressToClient ({#Char},{#Char},Int,[Int])
where {
	SendAddressToClient _ (string,s2,id,symbol_addresses) io
		#! encoded_symbol_addresses
			= foldl (\s i -> s +++ (FromIntToString i)) "" symbol_addresses;
		#! encoded_id
			= FromIntToString id;
		| ReplyReqS (string +++ s2 +++ encoded_id +++ encoded_symbol_addresses)
			= io;
}; 


class EncodeClientMessage a
where {
	EncodeClientMessage :: a -> !String
};

instance EncodeClientMessage [Int]
where {
	EncodeClientMessage symbol_addresses
		#! s
			= foldl (\s i -> s +++ (FromIntToString i)) "" symbol_addresses;
		= s;
};
	

//1.3
instance Target2 !Int
//3.1
/*2.0
instance Target2 Int
0.2*/
where {
	WriteOutput {file_or_memory,offset, string,state,file_n} mem_ptr
		#! aligned_offset
			= roundup_to_multiple offset 4;
		#! q
			= mwrites file_or_memory aligned_offset string mem_ptr;
//		| True <<- ("mem_ptr",hex_int q)
		= (state,q);
};

:: WriteImageInfo
	= {
		wii_code_start	:: !Int
	,	wii_code_end	:: !Int
	,	wii_data_start	:: !Int
	,	wii_data_end	:: !Int
	};
	
default_write_image_info :: WriteImageInfo;
default_write_image_info
	= {
		wii_code_start	= 0
	,	wii_code_end	= 0
	,	wii_data_start	= 0
	,	wii_data_end	= 0
	};

getMemory3 :: (!*IOState s) -> (!*Mem,!*IOState s);
getMemory3 io
	= (Mem,io);
		
putMemory3 :: !*Mem (!*IOState s) -> !*IOState s;
putMemory3 mem io
		= io;
	
ReceiveCodeDataAdr3 text_end_vaddr bss_end_vaddr mem
	#! (b1,i1,i2)
		= ReceiveCodeDataAdr text_end_vaddr bss_end_vaddr;
//	| i1 < 0x0000ffff || i2 < 0x0000ffff <<- (text_end_vaddr,bss_end_vaddr)
//		= abort "too small";
	= (b1,i1,i2,mem);
	
NeedBaseLibraries3 library_list n_libraries state mem
	#! (library_list,state)
		= NeedBaseLibraries library_list n_libraries state;
	= (library_list,state,mem);
	
FlushBuffers3 file mem

	#! q 
		= FlushBuffers file;
	= (q,mem);

		
	
// 		= NeedBaseLibraries library_list n_libraries state;


write_image :: !*State (!*IOState s) -> !(!Int,WriteImageInfo,!*State,!*IOState s);
write_image state=:{n_xcoff_symbols,n_library_symbols,library_list,n_libraries,n_xcoff_files,one_pass_link} files
// new ...
	# (mem,files)
		= getMemory3 files;
// ... new

	#! (marked_bool_a,state)
		= select_marked_bool_a state;
	#! (marked_offset_a,state)
		= select_marked_offset_a state;
	#! (module_offset_a,state)
		= select_module_offset_a state;
	#! (xcoff_a,state)
		= select_xcoff_a state;
		
	# xcoff_list = xcoff_array_to_list 0 xcoff_a;

	// TEXT, calculating text size
	#! (marked_bool_a,text_end_vaddr0,module_offset_a, xcoff_list)
		= compute_module_offsets Text 0 xcoff_list 0  0 marked_bool_a module_offset_a;
	
	#! (marked_bool_a,_,n_imported_symbols)
		= compute_idata_strings_size library_list 0 0 n_xcoff_symbols marked_bool_a;

	# text_end_vaddr = text_end_vaddr0+4 * n_imported_symbols;

	// DATA, calculating data size		
	# (marked_bool_a,data_end_vaddr,module_offset_a, xcoff_list)
		= compute_module_offsets Data 0 xcoff_list 0 0 marked_bool_a module_offset_a;

	bss_vaddr = data_end_vaddr; //(data_end_vaddr+4095) bitand (-4096);

	#! (marked_bool_a,bss_end_vaddr,module_offset_a, xcoff_list)
		= compute_module_offsets Bss 0 xcoff_list bss_vaddr 0 marked_bool_a module_offset_a;
	| True <<- ("sizes:", text_end_vaddr,bss_end_vaddr)

//	#! (ok,code_p,data_p) 
//		= ReceiveCodeDataAdr text_end_vaddr bss_end_vaddr;
	#! (ok,code_p,data_p,mem) 
		= ReceiveCodeDataAdr3 text_end_vaddr bss_end_vaddr mem;
	| not ok <<- ("ReceiveCodeDataAdr",hex_int code_p,hex_int data_p)
		= abort ("killed" +++ toString code_p +++ " - " +++ toString bss_vaddr); 
	
	#! (udata_p,data_p)
		= MakeNonUnique data_p;
			
	#! (ucode_p,code_p)
		= MakeNonUnique code_p;
		
	// verbose
	#! code_msg
		= if (text_end_vaddr <> 0)
				[Verbose ("!code from " +++ (hex_int code_p) +++ " to " +++ (hex_int (dec code_p+text_end_vaddr)) +++ " - " +++ toString (/*dec*/ text_end_vaddr) +++ " bytes")]
				[]
				;
	#! data_msg
		= if (bss_end_vaddr <> 0)
				[Verbose ("!data from " +++ (hex_int data_p) +++ " to " +++ (hex_int (dec data_p+bss_end_vaddr)) +++ " - " +++ toString (/*dec*/ bss_end_vaddr) +++ " bytes")]
				[]
				;
				
	#! messages
		= code_msg ++ data_msg;
	/*
		= [
			Verbose ("code from " +++ (hex_int code_p) +++ " to " +++ (hex_int (dec code_p+text_end_vaddr)) +++ " - " +++ toString (/*dec*/ text_end_vaddr) +++ " bytes")
		,	Verbose ("data from " +++ (hex_int data_p) +++ " to " +++ (hex_int (dec data_p+bss_end_vaddr)) +++ " - " +++ toString (/*dec*/ bss_end_vaddr) +++ " bytes")
		];
	*/
	
	#! wii
		= {
			wii_code_start	= code_p
		,	wii_code_end	= code_p + text_end_vaddr
		,	wii_data_start	= data_p
		,	wii_data_end	= data_p + bss_end_vaddr
		};
	#! state
		= SetLinkerMessages messages state;

	// Rebase text segment	
	#! (marked_bool_a,_,module_offset_a, xcoff_list)
		= compute_module_offsets Text code_p xcoff_list 0 0 marked_bool_a module_offset_a;
		
//	#! (library_list,state) 
//		= NeedBaseLibraries library_list n_libraries state;
	#! (library_list,state,mem) 
		= NeedBaseLibraries3 library_list n_libraries state mem;

	#! (ok,state)
		= IsErrorOccured state;
	| not ok
		= (0,default_write_image_info,state,files);

		
	#! (marked_bool_a,library_list,_,module_offset_a) 
		= Dcompute_imported_library_symbol_offsets library_list (code_p+text_end_vaddr0) (~n_libraries) n_xcoff_symbols marked_bool_a module_offset_a;
	
	// ----
	// DATA
	#! (marked_bool_a,_,module_offset_a, xcoff_list)
		= compute_module_offsets Data data_p xcoff_list 0 0 marked_bool_a module_offset_a;

	#! (marked_bool_a,_,module_offset_a, xcoff_list)
		= compute_module_offsets Bss data_p xcoff_list bss_vaddr 0 marked_bool_a module_offset_a;

	#! state = { state &
		// Nieuw:
		n_libraries = n_libraries,
		n_xcoff_symbols = n_xcoff_symbols,
		n_library_symbols = n_library_symbols,
		library_list = library_list,
		//namestable = names_table,
	
		// Oud:
		n_xcoff_files = n_xcoff_files,
		marked_bool_a = marked_bool_a,
		marked_offset_a = marked_offset_a,
		module_offset_a = module_offset_a,
		xcoff_a = xcoff_list_to_xcoff_array xcoff_list n_xcoff_files,
		one_pass_link = one_pass_link
 	 };
 	/*
	| True <<- "write_image"
	#! ucode_p_anne
		= case code_p of {
			0
				-> udata_p;

			_
				-> ucode_p;
		};
	*/
	#! ((file,_,state),files)
		= (accFiles (write_code_to_pe_files n_xcoff_files True 0 0 (0,0) state one_pass_link ucode_p) files);//
//		= (accFiles (write_code_to_pe_files n_xcoff_files True 0 0 (0,0) state one_pass_link ucode_p_anne) files);
//	#! q
//		= FlushBuffers file;
	#! (q,mem)
		= FlushBuffers3 file mem;

	| q <> 1
		= abort "FlushBuffers";
		
	#! files
		= putMemory3 mem files;
	
	= (0,wii,state,files);
//where {
	 
	/*
	** The base of each library is calculated again and again. Clearly this can
	** be optimized but then also the AddAndInit must also be adopted because 
	** the bases need to be filled in the library list. 
	*/
	
	NeedBaseLibraries :: !LibraryList !Int !*State -> (!LibraryList,!*State);
	NeedBaseLibraries libraries n_libraries_ll state
		#! (n_libraries,library_names)
			= need_libraries 0 libraries ""; 
		| True <<- ("NeedBaseLibraries",library_names)
		#! (ok,library_addresses)
			= need_base_libraries library_names n_libraries;
		| not ok
			#! msg
				= "NeedBaseLibraries: one of the required dynamic libraries cannot be found (needs improvement)";
			= (libraries,AddMessage (LinkerError msg) state);
		
		
			//= abort "NeedBaseLibraries";
		= (store_base_addresses library_addresses 0 libraries,state);
	where
	{
		need_libraries :: !Int !LibraryList !String  -> (!Int,!String);
		need_libraries accu EmptyLibraryList libraries
			= (accu,libraries +++ "\0");
		need_libraries accu (Library library_name _ _ _ librarylists) libraries
		    | library_name == ""
		    	= abort "need_libraries:  library without name";
//		   	| ends library_name "ClientChannel.dll"
//		   		= need_libraries librarylists libraries;
				= need_libraries (inc accu)  librarylists (libraries +++ library_name +++ "\0");
			
		need_base_libraries :: !String !Int -> (!Bool,!String);
		need_base_libraries _ _
			= code {
				ccall NeedBaseLibraries "SI-IS"
			};
			
		store_base_addresses :: !String !Int !LibraryList -> !LibraryList;
		store_base_addresses _ _ EmptyLibraryList
			= EmptyLibraryList;
		store_base_addresses library_addresses ith_address (Library library_name library_base_address library_symbols_list n_library_symbols library_list)
// new ...
/*
			| ends library_name "ClientChannel.dll"
				#! new_libraries
					= store_base_addresses library_addresses (ith_address+4) library_list
				= Library library_name library_base_address library_symbols_list n_library_symbols new_libraries;
*/
// ... new

			#! library_base_address
				= library_addresses ILONG ith_address;
			#! new_libraries
				= store_base_addresses library_addresses (ith_address+4) library_list
			= Library library_name library_base_address library_symbols_list n_library_symbols new_libraries;
	};
// }