implementation module WriteState

// pc: from ExtString import ILONG;
//from ExtFile import ExtractPathFileAndExtension, ExtractPathAndFile;
import xcoff;
import ExtFile;
import
	SymbolTable,
	State,
	ReadWriteState,
	LinkerOffsets,
	CommonObjectToDisk 
	
	
import
	ExtArray,
	ExtFile;

import pdWriteState;

invert_marked_bool_a :: !*State -> (!*{#Bool},!*State)
invert_marked_bool_a state 
	#! (marked_bool_a, state)
		= select_marked_bool_a state
	#! (size, marked_bool_a)
		= usize marked_bool_a
	#! inverted_marked_bool_a
		= { False \\ i <- [1..size] }
	#! (inverted_marked_bool_a, marked_bool_a)
		= invert 0 size inverted_marked_bool_a marked_bool_a
	= (inverted_marked_bool_a,{state & marked_bool_a = marked_bool_a})
	
	where
		invert :: !Int !Int !*{#Bool} !*{#Bool} -> (!*{#Bool},!*{#Bool})
		invert i limit inverted_marked_bool_a marked_bool_a
			| i == limit
				= (inverted_marked_bool_a,marked_bool_a)
				
			#! (element,marked_bool_a)
				= marked_bool_a![i]
			= invert (inc i) limit {inverted_marked_bool_a & [i] = not element} marked_bool_a
	
import 
	DebugUtilities,
	ExtString;

ExtractPathAndFile2 :: !String -> (!String,!String);
ExtractPathAndFile2 path_and_file 
	#! (dir_delimiter_found,i)
		= CharIndexBackwards path_and_file (size path_and_file - 1) path_separator;
	| dir_delimiter_found
		# file_name_with_extension
			= path_and_file % (i+1,size path_and_file - 1);
		= (if (i == 0) "\\" (path_and_file % (0,i-1)),file_name_with_extension);
		= ("",path_and_file);
	
WriteState :: !*State !*Files -> (!*State,!*Files)
WriteState state=:{n_libraries, n_xcoff_files, n_xcoff_symbols, n_library_symbols, library_list, application_name,library_file_names} /*, marked_bool_a, marked_offset_a, module_offset_a, xcoff_a, namestable}*/ files
	#! (path, file_name_with_extension)
		= ExtractPathAndFile2 application_name
	#! (file_name, _)
		= ExtractPathFileAndExtension file_name_with_extension

	#! state_file_name
		= construct_path path (file_name +++ ".dat");
	#! (ok, output, files)
		= fopen state_file_name FWriteData files
	|  not ok
		#! state 
			= AddMessage (LinkerWarning ("could not write complement " +++ state_file_name)) state;
		=  (state,files);
		
	/*
	** Compute offset of unmarked modules in .dat--file to be written
	*/
	// +4 voor de size
	#! (inverted_marked_bool_a,state)
		= invert_marked_bool_a state


	#! (marked_bool_a,state)
		= select_marked_bool_a state
		
	// write header
	#! output
		= WriteComplementVersion ComplementVersion output;
		
	// first free offset after raw data
	#! (fp_after_header,output)
		= fposition output;
	#! output
		= fwritei 0 output;
		
	// mac
	#! (state,output,files)
		= write_raw_data {state & marked_bool_a = inverted_marked_bool_a} output files;
		
	// update offset at beginning of complement
	# (current_fp,output)	
		= fposition output;
	# (_,output)
		= fseek output fp_after_header FSeekSet ;
	# output
		= fwritei current_fp output;
	# (_,output)
		= fseek output current_fp FSeekSet;
	
		
	#! state =
		{ state &
			marked_bool_a = marked_bool_a
		}
		
	/*
	** Pas op: je kunt niet zonder meer bytes voor de code/data gaan schrijven 
	** omdat de offsets vastliggen in de symbols voor elke module
	*/
		
	/*
	** Write counters
	*/
	#! output
		= fwritei n_libraries output 
	
	#! output
		= fwritei n_xcoff_files  output
	#! output
		= fwritei n_xcoff_symbols output
	#! output
		= fwritei n_library_symbols output
	
	// dynamic libraries
	#! output
		= WriteLibraryList library_list output
	#! output
		= WriteLibraryFileNames library_file_names output
		
	/*
	** Write marked_bool_a
	*/ 
	#! (marked_bool_a,state)
		= select_marked_bool_a state
//	#! (s_marked_bool_a,marked_bool_a)
//		= usize marked_bool_a
		
	// new
//	#! output
//		= fwritei s_marked_bool_a output;
	#! (marked_bool_a,output)
		= loopAonOutput (\bool output -> fwritec (if bool 'T' 'F') output) marked_bool_a output;

/*
	// old
	#! marked_bool_s
		= { if (is_true) ('T') ('F') \\ is_true <-: marked_bool_a }		
	#! output
		= fwritei s_marked_bool_a output
	#! output
		= fwrites marked_bool_s output
*/
				
	/*
	** Write marked_offset_a
	*/
	#! (marked_offset_a,state)
		= select_marked_offset_a state
	// new
/*
	#! (s_marked_offset_a,marked_offset_a)
		= usize marked_offset_a;
	#! output
		= fwritei s_marked_offset_a output
*/
	#! (marked_offset_a,output)
		= loopAonOutput fwritei marked_offset_a output;
	
	/*
	** Write module_offset_a
	*/
	#! (module_offset_a,state)
		= select_module_offset_a state
/*	
	#! (s_module_offset_a,module_offset_a)
		= usize module_offset_a;
	#! output
		= fwritei s_module_offset_a output
*/
	#! (module_offset_a,output)
		= loopAonOutput fwritei module_offset_a output;

	/*
	** Write xcoff_a
	** The total size in characters of the encoded array does not precede
	** the encoded array.
	*/ 
	#! (xcoff_a,state)
		= select_xcoff_a state
	#! (xcoff_a,output)
		= loopAurOnOutput write_xcoff xcoff_a output

	/*
	** write namestable
	*/
	#! (state,output)
		= WriteNamesTable state output
				
	/*
	** Close file
	*/
	#! (ok, files)
		= fclose output files		
		
	#! state 
		= { state &
			marked_bool_a	= marked_bool_a
		,	marked_offset_a	= marked_offset_a
		,	module_offset_a	= module_offset_a
		,	xcoff_a			= xcoff_a
		};		
	= ( state, files)	

/*
	,	application_name	:: !String
	,	n_libraries			:: !Int
	,	n_xcoff_files 		:: !Int
	,	n_xcoff_symbols		:: !Int
	,	n_library_symbols	:: !Int
	,	library_list 		:: !LibraryList
	,	marked_bool_a		:: !*{#Bool}
	,	marked_offset_a		:: !*{#Int}
	,	module_offset_a		:: !*{#Int}
	,	xcoff_a 			:: {#*Xcoff}
	,	namestable			:: *NamesTable
	
	//  macOS; only used by dynamic linker
	,	toc_p				:: !Int
};
*/			
// PLATFORM INDEPENDENT
// mac: WriteXCoffArray :: !{#/*PC S*/xXcoff} !Int !*File -> !*File

/*
WriteXCoffArray :: !{#SXcoff} !Int !*File -> !*File
WriteXCoffArray xcoff_a i output
	| size xcoff_a == i 
		= output
		
		#! output
			= WriteXCoff xcoff_a.[i] output
		= WriteXCoffArray xcoff_a (inc i) output
*/

/*
// WriteXCoffArray :: *(a b) .c .d -> (.(a b),.d) | Array .a & replace_u , update_u , usize_u b;
//WriteXCoffArray :: *(a v:SXcoff) .b -> (u:(a w:SXcoff),.b) | Array .a, [u v <= w];
WriteXCoffArray xcoff_a output
	#! (xcoff_a,output)
		= loopAur write_xcoff xcoff_a output;
	= (xcoff_a,output);
	
	
	/*
		#! (marked_bool_a,output)
		= loopA (\bool output -> fwritec (if bool 'T' 'F') output) marked_bool_a output;
		*/
*/		

	
			

/*
class DefaultElem .e
where
	DefaultElem :: .e

instance DefaultElem Int
where DefaultElem  = 42

instance DefaultElem (*SXcoff)
where DefaultElem = empty_xcoff
*/

WriteNamesTable :: !*State !*File -> (!*State,!*File)
WriteNamesTable state output 
	#! (namestable,state)
		= select_namestable state
	#! (size_names_table,namestable)
		= usize namestable
	#! n_elements
		= CountNamesTableElements 0 size_names_table 0 namestable
		
	#! (namestable,output)
		= loopAonOutput write_names_table_elements namestable output;
		
	// update state
	#! state
		= { state &
			namestable = namestable
		}

	= (state,/*write_names_table 0 size_names_table namestable output*/ output)	
	where		
		
		/*
		write_names_table i limit namestable file
			| i == limit
				= file
				
				#! file
					= write_names_table_elements namestable.[i] file
				=  write_names_table (inc i) limit namestable file
	
		where
	*/
		write_names_table_elements EmptyNamesTableElement file
			= file
		write_names_table_elements (NamesTableElement s i0 i1 ntes) file
			#! file
				= fwrites s file
			#! file
				= fwritec '\n' file
			#! file
				= fwritei i0 file
			#! file
				= fwritei i1  file
			= write_names_table_elements ntes file
		
		/*
		** If the complement is extended, the amount of names table elements
		** need to be counted. Uncomment the comments above and in ReadState
		*/		
		CountNamesTableElements i limit n_names_table_elements namestable
			| i == limit
				=  n_names_table_elements
				
				#! n_names_table_elements
					= count n_names_table_elements namestable.[i]
				= CountNamesTableElements (inc i) limit n_names_table_elements namestable
			where
				count n_names_table_elements EmptyNamesTableElement
					=  n_names_table_elements
				count n_names_table_elements (NamesTableElement _ _ _ ntes)
					=  count (inc n_names_table_elements) ntes 
	
// ---------------------------------------------------------------------------------
WriteLibraryList :: !LibraryList !*File -> !*File
WriteLibraryList EmptyLibraryList output
	=  output
WriteLibraryList (Library s /* mac */ i0 lsl i1 ll) output
	#! output
		= fwrites s output
	#! output
		= fwritec '\n' output

	// PC
	#! output
		= fwritei i0 output
	#! output
		= WriteLibrarySymbolsList lsl output
	#! output 
		= fwritei i1 output
	= WriteLibraryList ll output
where
	WriteLibrarySymbolsList lsl output
		#! output
			= fwritei (count lsl 0) output
		#! output
			= write_library_symbols_list lsl output
		= output
	where
		count EmptyLibrarySymbolsList i 
			= i
		count (LibrarySymbol _ lsl) i
			= count lsl (inc i)
	
		write_library_symbols_list EmptyLibrarySymbolsList output 
			= output
		write_library_symbols_list (LibrarySymbol s lsl) output
			#! output 
				= fwrites s output
			#! output
				= fwritec '\n' output
			= write_library_symbols_list lsl output

WriteLibraryFileNames library_file_names output
	// length = n_libraries
	#! output
		= foldl write_name output library_file_names;
	= output;
where
	write_name output s
		#! output
			= fwritei (size s) output;
		#! output
			= fwrites s output;
		= output;

		
// PLATFORM DEPENDENT
// platform specific
/*
instance Output (!{#Char},!*File)
where
//	WriteOutput :: !WriteOutputRecord /*!Int !Int !{#Char}*/ (!*{#Char},!*File) -> (!*{#Char},!*File);
	WriteOutput {file_or_memory,offset,string} /*0 _ string*/ (data,file)
		= case file_or_memory of {
			0
				-> (data, fwrites string file);
			1
				-> (data +++ string, file);
				
			_
				-> abort "WriteState: internal error";
		};
			
	ChangeState {file_n,module_n,state} pe_file
		#! (Module i0 i1 i2 i3 offset i5 s, state)
			= sel_symbol file_n module_n state	
		/*
		** Retrieve the computed offset of module_n in the file
		*/	
		#! (first_symbol_n,state)
			= selacc_marked_offset_a file_n state
		#! (module_n_offset, state)
			= selacc_module_offset_a (first_symbol_n+module_n) state;	
		
	 	#! state
			= update_symbol (Module i0 i1 i2 i3 (module_n_offset+4) i5 s) file_n module_n state 
		= (state,pe_file);
	*/	
	
/*
INSERT ME HERE
	#! (xcoff_a,state)
		= select_xcoff_a state
	#! xcoff_list 
		= xcoff_array_to_list 0 xcoff_a
 
	#! (module_offset_a,state)
		= select_module_offset_a state

	// mac
	#! (text_end,data_end)
		= (0,0);
/*
	// pc
	#! (inverted_marked_bool_a,text_end,module_offset_a,xcoff_list) 
		= compute_module_offsets Text 0 /* base */ xcoff_list 0 	   0 inverted_marked_bool_a module_offset_a
	#! (inverted_marked_bool_a,data_end,module_offset_a,xcoff_list)
		= compute_module_offsets Data 0 /* base */ xcoff_list text_end 0 inverted_marked_bool_a module_offset_a
*/
	#! state = 
		{ state &
			xcoff_a = xcoff_list_to_array n_xcoff_files xcoff_list, // PC xcoff_list_to_xcoff_array xcoff_list n_xcoff_files,
			module_offset_a = module_offset_a,
			marked_bool_a = inverted_marked_bool_a
			
		}
		// xcoff_list_to_array
	#! output
		= fwritei data_end output

	// moved	
	#! alignment
		= 2;
	#! alignment_mask
		= dec (1 << alignment);
	#! aligned_text_end
		= (text_end + alignment_mask) bitand (bitnot alignment_mask);
	#! delta
		= aligned_text_end - text_end;

	// inserted
	#! nop_byte
		= toChar 0x90;
	#! s_data_section
		= data_end - aligned_text_end;
	
	// mac
	#! data
		= "";	
	/*
	PC
//	#! ((_,data,output),state,files)
//		= write_code_to_pe_filesD n_xcoff_files /*True*/ False 0 0 (0,0) state (0,createArray s_data_section nop_byte,output) files;

	#! ((data,output),state,files)
		= write_code_to_pe_files n_xcoff_files False 0 0 (0,0) state True ("",output) files
	*/  

	#! nop_byte
		= toChar 0x90;
	# output
		= fwrites (createArray delta nop_byte) output	
		
	#! (i,output)
		= fposition output
	| i <> (4 + text_end + delta)
		= abort ("WriteState: computed text size does not correspond with file offset" +++ (toString i))
	
	#! output
		= fwrites data output
	#! (i,output)
		= fposition output
	#! required_offset
		= 4 + data_end
	| i <> required_offset
		= abort ("Real: " +++ (toString required_offset) +++ " - " +++ (toString i))
*/