implementation module piObjectToDisk;

// platform independent Object to Disk

import StdEnum;

import PlatformLinkOptions/*, WriteState*/, LinkerMessages;
import ExtInt, ExtFile;

import DebugUtilities;

Analyse :: !*(!Int,!Int,!*State,!*PlatformLinkOptions,!*Files) !Int  -> *(!Int,!Int,!*State,!*PlatformLinkOptions,!*Files);
Analyse (fp,start_rva,state=:{n_library_symbols,n_xcoff_symbols,n_libraries,library_list},platform_link_options,files) i		
	#! (is_virtual_section,i_section_header,s_virtual_data,alignment,s_raw_data,state,platform_link_options,files)
		= apply_compute_section i start_rva fp platform_link_options state files;

	// check for link errors	
	#! (ok,state)
		= IsErrorOccured state;
	| not ok
		= (fp,start_rva,state,platform_link_options,files);
		
	#! start_rva
		= start_rva + (if (s_raw_data == 0) (roundup_to_multiple s_virtual_data 4096) (roundup_to_multiple s_raw_data 4096));
	#! (fp,platform_link_options)
		= case is_virtual_section of {
			True
				-> (fp,platform_link_options);				
			False
//				| F ("Analyse fp: " +++ toString fp +++ " section: " +++ toString i) True
				// alignment
				#! s_raw_data_512
					= case s_raw_data of {
						0
							-> roundup_to_multiple s_virtual_data alignment;
						_
							// section containing raw data, but no virtual size e.g. resource section
							-> roundup_to_multiple s_raw_data alignment;
					};
				#! platform_link_options
					= plo_set_s_raw_data s_raw_data_512 i_section_header platform_link_options;
				#! platform_link_options
					= plo_set_fp_section fp i_section_header platform_link_options;
				-> (fp + s_raw_data_512,platform_link_options);
		}	
	= (fp,start_rva,state,platform_link_options,files);
	
check_fp :: !Int !Int !String !*File -> *File; 
check_fp computed_fp i s pe_file
	# (actual_fp,pe_file)
		= fposition pe_file;
	| computed_fp <> actual_fp
		# error
			= "Generate; " +++ s +++ "\ncomputed_fp: " +++ toString computed_fp +++ " , actual_fp: " +++ toString actual_fp +++ " , section: " +++ toString i;
		= abort error;
		= pe_file;
		

Generate (pe_file,state,files,platform_link_options) i

	// debug
	# (computed_start_fp,platform_link_options)
		= plo_get_section_fp i platform_link_options;
//	# pe_file
//		= check_fp computed_start_fp i "start 1" pe_file;
		
	# (is_virtual_section,s_virtual_data,s_raw_text_section,pe_file,platform_link_options,state,files)
		= apply_generate_section i pe_file platform_link_options state files;
		
	// check for link errors	
	#! (ok,state)
		= IsErrorOccured state;
	| not ok
		= abort "Generate: errors set"; //(pe_file,state,files,platform_link_options);
		
	# (computed_end_fp,platform_link_options)
		= plo_get_section_fp i platform_link_options;
//	# pe_file
//		= check_fp (computed_end_fp + s_virtual_data) i "end (unaligned) 2" pe_file;
		
	# pe_file
		= case (is_virtual_section || s_virtual_data == 0) of {
			True
				-> pe_file;
			False
				-> write_zero_bytes_to_file (s_raw_text_section - s_virtual_data) pe_file;
		}
	
	# (computed_end_fp,platform_link_options)
		= plo_get_section_fp i platform_link_options;
//	# pe_file
//		= check_fp (computed_end_fp + s_raw_text_section) i "end (unaligned) 3" pe_file;
		
		
	= (pe_file,state,files,platform_link_options);

/*
OLD
write_object_to_disk :: !Bool .{#Char} Int Int Int .LibraryList Int *{#Bool} *{#Int} *{#*Xcoff} *Files !*NamesTable !PlatformLinkOptions
 -> (/*!Bool,*/!*State,!PlatformLinkOptions,*Files);
write_object_to_disk normal_static_link application_file_name  n_xcoff_files n_libraries n_library_symbols library_list0 
		 n_xcoff_symbols marked_bool_a offset_a xcoff_a1 
		 files namestable platform_link_options
	#! state
		= { EmptyState &
			application_name = application_file_name,
			n_libraries = n_libraries,
			n_xcoff_symbols = n_xcoff_symbols,
			n_library_symbols = n_library_symbols,
			library_list = library_list0,
			namestable = namestable,
		
			n_xcoff_files = n_xcoff_files,
			marked_bool_a = marked_bool_a,
			marked_offset_a = offset_a,
	//		module_offset_a = module_offset_a,
			xcoff_a = xcoff_a1
		};

	// determine what sections are put into an executable					
	#! (s_section_header_a,platform_link_options)
		= create_section_header_kinds platform_link_options;

	# section_header_index_list
		= [0..dec s_section_header_a];

	// get start filepointer (fp) and relative virtual start address		
	# (start_fp,platform_link_options)
		= plo_get_start_fp platform_link_options;
	# (start_rva,platform_link_options)
		= plo_get_start_rva platform_link_options;
		
	// Analyze
	#! (fp,end_rva,state,platform_link_options)
		= foldl Analyse (start_fp,start_rva,state,platform_link_options) section_header_index_list; 	
		
	// check for link errors during analysis	
	#! (ok,state)
		= st_isLinkerErrorOccured state;
	| not ok
		= (state,platform_link_options,files);
		
		
	// set end filepointer (fp) and relative virtual end address
	# platform_link_options
		= plo_set_end_rva end_rva platform_link_options;
	# platform_link_options
		= plo_set_end_fp fp platform_link_options;
		
	// open 
	#! (open_ok,pe_file,files)
		= fopen application_file_name FWriteData files;
	| not open_ok
		# open_error
			= LinkerError ("could not create '" +++ application_file_name +++ "'");
		# state
			= st_addLinkerMessage open_error state;
		= (state,platform_link_options,files);
		
	#! (pe_file,state,files,platform_link_options)
		= case open_ok of {
			True
				#! (pe_file,state,files,platform_link_options)
					= foldl Generate (pe_file,state,files,platform_link_options) section_header_index_list;
					
				// check for link errors during generation	
				#! (ok,state)
					= st_isLinkerErrorOccured state;
				| not ok
					-> (pe_file,state,files,platform_link_options);
		
				// write complement
				#! (state,files)
						= case normal_static_link of {
						 	True	->	(state,files);
						 	False	->	(WriteState state files);
						 };
						 
				// check for link errors during complement generation	
				#! (ok,state)
					= st_isLinkerErrorOccured state;
				| not ok
					-> (pe_file,state,files,platform_link_options);

				-> (pe_file,state,files,platform_link_options);

			False
				-> (pe_file,state,files,platform_link_options);
		};
		
	#! (close_ok,files)
		= fclose pe_file files;
	= (/*open_ok && close_ok,*/ state,platform_link_options,files);
*/


write_object_to_disk :: !PlatformLinkOptions !*State !*Files -> (!*State,!PlatformLinkOptions,!*Files);
write_object_to_disk platform_link_options state=:{normal_static_link,application_name = application_file_name}  files 
/*
	#! state
		= { EmptyState &
			application_name = application_file_name,
			n_libraries = n_libraries,
			n_xcoff_symbols = n_xcoff_symbols,
			n_library_symbols = n_library_symbols,
			library_list = library_list0,
			namestable = namestable,
		
			n_xcoff_files = n_xcoff_files,
			marked_bool_a = marked_bool_a,
			marked_offset_a = offset_a,
	//		module_offset_a = module_offset_a,
			xcoff_a = xcoff_a1
		};
*/

	// determine what sections are put into an executable					
	#! (s_section_header_a,state,platform_link_options)
		= create_section_header_kinds state platform_link_options;

	// check for link errors during creation of section headers	
	#! (ok,state)
		= IsErrorOccured state;
	| not ok
		= (state,platform_link_options,files);
		
	# section_header_index_list
		= [0..dec s_section_header_a];

	// get start filepointer (fp) and relative virtual start address		
	# (start_fp,platform_link_options)
		= plo_get_start_fp platform_link_options;
	# (start_rva,platform_link_options)
		= plo_get_start_rva platform_link_options;
		
	// Analyze
	#! (fp,end_rva,state,platform_link_options,files)
		= foldl Analyse (start_fp,start_rva,state,platform_link_options,files) section_header_index_list;
		
	// check for link errors during analysis	
	#! (ok,state)
		= IsErrorOccured state;
	| not ok
		= (state,platform_link_options,files);
		
		
	// set end filepointer (fp) and relative virtual end address
	# platform_link_options
		= plo_set_end_rva end_rva platform_link_options;
	# platform_link_options
		= plo_set_end_fp fp platform_link_options;
		
	// open 
	#! (open_ok,pe_file,files)
		= fopen application_file_name FWriteData files;
		
		
	| not open_ok
		# open_error
			= LinkerError ("could not create '" +++ application_file_name +++ "'");
		# state
			= AddMessage open_error state;
		= (state,platform_link_options,files);
		
	#! (pe_file,state,files,platform_link_options)
		= case open_ok of {
			True
				#! (pe_file,state,files,platform_link_options)
					= foldl Generate (pe_file,state,files,platform_link_options) section_header_index_list;
					
				// check for link errors during generation	
				#! (ok,state)
					= IsErrorOccured state;
				| not ok
					-> (pe_file,state,files,platform_link_options);
		
				// write complement
				#! (state,files)
						= case normal_static_link of {
						 	True	->	(state,files);
						 	False	->	(state,files); //(WriteState state files);
						 };
						 
				// check for link errors during complement generation	
				#! (ok,state)
					= IsErrorOccured state;
				| not ok
					-> (pe_file,state,files,platform_link_options);

				-> (pe_file,state,files,platform_link_options);

			False
				-> (pe_file,state,files,platform_link_options);
		};
		
	#! (close_ok,files)
		= fclose pe_file files;
	= (/*open_ok && close_ok,*/ state,platform_link_options,files);