implementation module pdWriteState;

// winOS

import ReadWriteState;
import SymbolTable;
import State;
import ExtFile;
import ExtArray;

loopAonOutput f a output :== loopAonOutput2 f a output
where {
	loopAonOutput2 f a output
		#! (s_a,a)
			= usize a;
		#! output
			= fwritei s_a output;
		= loopA f a output;
}

write_xcoff :: !*Xcoff !*File -> (!*Xcoff,!*File);
write_xcoff xcoff=:{file_name,symbol_table,n_symbols} output
	#! output 
		= fwrites file_name output;
	#! output
		= fwritec '\n' output;
	#! (symbol_table,output)
		= write_symbol_table symbol_table output;
	#! output
		= fwritei n_symbols output;
	= ({xcoff & symbol_table = symbol_table},output);
where {
	write_symbol_table symbol_table=:{text_symbols,data_symbols,bss_symbols,imported_symbols,section_symbol_ns,symbols} output
		#! output = output
			THEN write_symbol_index_list text_symbols
			THEN write_symbol_index_list data_symbols
			THEN write_symbol_index_list bss_symbols
			THEN write_symbol_index_list imported_symbols
			;
		#! (section_symbol_ns,output)
			= loopAonOutput fwritei section_symbol_ns output;
		#! (symbols,output)
			= loopAonOutput write_symbol symbols output;
		= ({symbol_table & section_symbol_ns = section_symbol_ns},output);
	where {
		write_symbol_index_list sil output
			# output
				= fwritei (length sil 0) output;
			= write_symbol_index_list sil output;
			where {
				write_symbol_index_list EmptySymbolIndex output
					= output;
				write_symbol_index_list (SymbolIndex symbol_n sil) output
					= write_symbol_index_list sil (fwritei symbol_n output);
				
				length EmptySymbolIndex i		= i;
				length (SymbolIndex _ sil) 	i	= length sil (inc i);	
			} // write_symbol_index_list
			

	}	

}

/*
	

*/
WriteSymbolTable :: !SSymbolTable !*File -> !*File;
WriteSymbolTable symboltable=:{text_symbols,data_symbols,bss_symbols,imported_symbols,section_symbol_ns,symbols} output
	#! output 
		= WriteSymbolIndexList text_symbols output;
	#! output 
		= WriteSymbolIndexList data_symbols output;
	#! output 
		= WriteSymbolIndexList bss_symbols output;
	#! output 
		= WriteSymbolIndexList imported_symbols output;
	#! output
		= WriteIntArray section_symbol_ns output;
	#! output
		= WriteSymbolArray symbols output;
	= output;

	where	
	{
		WriteSymbolIndexList symbols output
			#! output 
				= fwritei (count 0 symbols) output;
			= write_symbol_index_list symbols output;
			where
			{
			 	count i EmptySymbolIndex 
					= i;
				count i (SymbolIndex _ sil)
					= count (inc i) sil;
					
				write_symbol_index_list EmptySymbolIndex output
					= output;
				write_symbol_index_list (SymbolIndex i sil) output
					#! output
						= fwritei i output;
					= write_symbol_index_list sil output;
			} // WriteSymbolIndexList
					
		WriteIntArray :: !{#Int} !*File -> !*File;
		WriteIntArray array output
			#! output
				= fwritei (size array) output;
			= write_int_array 0 (size array) array output;
		where
		{
			write_int_array i limit array output
				| i == limit
					= output;
					
					#! output
						= fwritei array.[i] output;
					= write_int_array (inc i) limit array output;
		}
					
		WriteSymbolArray :: {!Symbol} !*File -> !*File;
		WriteSymbolArray array output
			= write_symbol_array 0 (size array) array output;
		where
		{
			write_symbol_array :: !Int !Int {!Symbol} !*File -> !*File;
			write_symbol_array i limit array output
				| i == limit
					= output;
					
					#! output
						= WriteSymbol array.[i] output;
					= write_symbol_array (inc i) limit array output;
		}
	}

WriteXCoff :: SXcoff !*File -> !*File;
WriteXCoff xcoff=:{file_name,symbol_table,n_symbols} output
	#! output 
		= fwrites file_name output;
	#! output
		= fwritec '\n' output;
	#! output
		= fwritei n_symbols output;
	= WriteSymbolTable symbol_table output;

	
WriteSymbol :: !Symbol !*File -> !*File;
WriteSymbol (Module i0 i1 i2 i3 i4 i5 s) output
	#! output
		= fwritec (toChar MODULE_SYMBOL) output;
	#! output
		= fwritei i0 output;
	#! output
		= fwritei i1 output;
	#! output
		= fwritei i2 output;
	#! output
		= fwritei i3 output;
	#! output
		= fwritei i4 output;
	#! output
		= fwritei i5 output;
	#! output
		= fwritei (size s) output;
	#! output
		= fwrites s output;	
	= output;
	
WriteSymbol (Label i0 i1 i2) output
	#! output
		= fwritec (toChar LABEL_SYMBOL) output;
	#! output
		= fwritei i0 output;
	#! output
		= fwritei i1 output;
	#! output
		= fwritei i2 output;
	= output;
	
WriteSymbol (SectionLabel i0 i1) output
	#! output
		= fwritec (toChar SECTIONLABEL_SYMBOL) output;
	#! output
		= fwritei i0 output;
	#! output
		= fwritei i1 output;
	= output;

WriteSymbol (ImportLabel s) output
	#! output
		= fwritec (toChar IMPORTLABEL_SYMBOL) output;
	#! output
		= fwritei (size s) output;
	#! output
		= fwrites s output;
	= output;
	
WriteSymbol (ImportedLabel i0 i1) output
	#! output
		= fwritec (toChar IMPORTEDLABEL_SYMBOL) output ;
	#! output
		= fwritei i0 output;
	#! output
		= fwritei i1 output;
	= output;
	
WriteSymbol (ImportedLabelPlusOffset i0 i1 i2) output
	#! output
		= fwritec (toChar IMPORTEDLABELPLUSOFFSET_SYMBOL) output ;
	#! output
		= fwritei i0 output;
	#! output
		= fwritei i1 output;
	#! output
		= fwritei i2 output;
	= output;
	
WriteSymbol (ImportedFunctionDescriptor i0 i1) output
	#! output
		= fwritec (toChar IMPORTEDFUNCTIONDESCRIPTOR_SYMBOL) output ;
	#! output
		= fwritei i0 output;
	#! output
		= fwritei i1 output;
	= output;
	
WriteSymbol (EmptySymbol) output
	#! output
		= fwritec (toChar EMPTYSYMBOL_SYMBOL) output;
	= output;
							
import CommonObjectToDisk;
import LinkerOffsets;
import ExtInt;

import DebugUtilities;

/*
VOOR JOHN:
instance Output !(!*{#Char},!*File)
where {
	WriteOutput  :: !*WriteOutputRecord !*(!*{#Char},!*File) -> *(!*State,*(!*{#Char},!*File));
	WriteOutput {file_or_memory=write_kind,offset, string,state,file_n} (data,pe_file)
		#! aligned_offset
			= roundup_to_multiple offset 4;
		#! (data,pe_file)
			= case write_kind of {
				0
					// .text
					#! delta
						= aligned_offset - offset;
					#! pe_file
						= write_n_bytes delta pe_file;
					#! pe_file
						= fwrites string pe_file;	 
					-> (data,pe_file);
				1
					// .data
					/*
					#! (s_data,data2)
						= usize data;
					#! new_size
						= aligned_offset + size string;
					*/
				
					#! data3
						= case /*(new_size < s_data)*/ True of {
							True
								// buffer big enough
								#! s
									= "hier"; //"required: " +++ toString new_size +++ "old: " +++ toString s_data;
								| F s True
							//	#! (_,data2)
							//		= usize data2;
								-> data; //data2;
							False
							/*
								// buffer too small
	 							#! new_buffer_size
									= min (roundup_to_multiple new_size next_buffer_size_factor) (s_data + next_buffer_size_factor);
								#! (_,data)
									= copy 0 data 0 (createArray new_buffer_size '\0');
							*/
								-> abort "buffer too small"; //data;
						};
					
			
					//#! (_,data)
					//	= copy 0 string aligned_offset data;
					-> (data3,pe_file);
				
			};
		= (state,(data,pe_file));
	where {
		copy :: !Int !{#Char} !Int !*{#Char} -> !(!Int,!*{#Char});
		copy i s j d
			| i == size s
				= (j,d);
				= copy (inc i) s (inc j) {d & [j + 0] = s.[i]};
			
		write_n_bytes :: !Int !*File -> !*File;
		write_n_bytes 0 pe_file
			= pe_file;
		write_n_bytes n pe_file
			= write_n_bytes (dec n) (fwritec '\0' pe_file);
	}
};
*/

instance Output !(!*{#Char},!*File)
where {
	WriteOutput  :: !*WriteOutputRecord !*(!*{#Char},!*File) -> *(!*State,*(!*{#Char},!*File));
	WriteOutput {file_or_memory=write_kind,offset,module_n, string,state,file_n} (data,pe_file)
		// filepointer of module within complement
		#! (module_fp,pe_file)
			= fposition pe_file;
		
		// write to disk or buffer
		#! aligned_offset
			= roundup_to_multiple offset 4;
		#! o
			= case write_kind of {
				0
					// .text
					#! delta
						= aligned_offset - offset;
					#! pe_file
						= write_n_bytes delta pe_file;
					#! pe_file
						= fwrites string pe_file;	 
					-> (state,(data,pe_file));
				1
					// .data
					#! (s_data,data)
						= usize data;
					#! new_size
						= aligned_offset + size string;
				
					#! data
						= case (new_size < s_data) of {
							True
								// buffer big enough
								//#! (_,data)
								//	= usize data;
								-> data; //data2;
							False
								// buffer too small
	 							#! new_buffer_size
									= min (roundup_to_multiple new_size next_buffer_size_factor) (s_data + next_buffer_size_factor);
								#! (_,data)
									= copy 0 data 0 (createArray new_buffer_size '\0');
								-> data;
						};
					#! (_,data)
						= copy 0 string aligned_offset data;
						
					// update current module symbol
					#! (Module i0 i1 i2 i3 offset i5 s, state)
						= sel_symbol file_n module_n state;
				 	#! state
						= update_symbol (Module i0 i1 i2 i3 module_fp i5 s) file_n module_n state; 
					-> (state,(data,pe_file));
				
			};
		= o;
	where {
		copy :: !Int !{#Char} !Int !*{#Char} -> !(!Int,!*{#Char});
		copy i s j d
			| i == size s
				= (j,d);
				= copy (inc i) s (inc j) {d & [j + 0] = s.[i]};
			
		write_n_bytes :: !Int !*File -> !*File;
		write_n_bytes 0 pe_file
			= pe_file;
		write_n_bytes n pe_file
			= write_n_bytes (dec n) (fwritec '\0' pe_file);
	}
};

s_initial_buffer		:== 8192;
next_buffer_size_factor :== 4096;

// write raw data of unmarked symbols
write_raw_data :: !*State !*File !*Files -> (!*State,!*File,!*Files);
write_raw_data state=:{n_xcoff_files} output files
	// first free offset after raw data
	#! output
		= fwritei 0 output;
		
	#! s_virtual_data_section
		= s_initial_buffer;
		
	// write text symbols
	#! ((data,output),(text_end,data_end),state,files)
		= write_code_to_pe_files n_xcoff_files False 0 0 (0,0) state True (createArray s_virtual_data_section '\0',output) files;
	#! output
		= fwrites (data % (0,dec data_end)) output;
	= (state,output,files);	
		
/*
	#! (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
	#! (inverted_marked_bool_a,state)
		= select_marked_bool_a state
	// 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;
	

	#! ((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))
		
	= (state,output,files)

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);
*/