implementation module selectively_import_and_mark_labels;

import StdEnv;

import State;
import xcoff;
import ExtString;
import ExtArray;
import what_linker;
import link_switches;

replace_section_label_by_label2 :: !Int !Int !*State -> (!Int,!*State);
replace_section_label_by_label2 file_n symbol_n state
	#! (symbol,state) 
		= state!xcoff_a.[file_n].symbol_table.symbols.[symbol_n];
	= replace_section_label_by_label symbol file_n symbol_n state;

replace_section_label_by_label :: !Symbol !Int !Int !*State -> (!Int,!*State);
replace_section_label_by_label s=:(SectionLabel section_n label_offset) file_n symbol_n state
	| False <<- ("replace_section_label_by_label (" +++ toString file_n +++ ", hex=" +++ hex_int symbol_n +++ ")")
		= undef;
	#! (section_symbol_n,state)
		= state!xcoff_a.[file_n].symbol_table.section_symbol_ns.[section_n];
	| section_n >= 1 && section_symbol_n <> (-1)
		#! state
			= { state & 
				xcoff_a.[file_n].symbol_table.symbols.[symbol_n] = Label section_n label_offset section_symbol_n
			};
		= (section_symbol_n,state);
		
replace_section_label_by_label s=:(Label section_n label_offset section_symbol_n) file_n symbol_n state
	= (section_symbol_n,state);
		
has_section_label_already_been_replaced  :: !Int !Int !*State -> (!Bool,!*State);
has_section_label_already_been_replaced file_n symbol_n state
	#! (symbol,state) 
		= state!xcoff_a.[file_n].symbol_table.symbols.[symbol_n];
	= case symbol of {
		SectionLabel _ _	-> (False,state);
		Label _ _ _			-> (True,state);
	};
import ExtInt;
selective_import_symbol :: !Int !Int !*(!*{#Bool},!*State) -> *(!*{#Bool},!*State);
selective_import_symbol file_n symbol_n (newly_marked_bool_a,state)	
	#! (symbol_offset,state)
		= symbol_n_to_offset file_n symbol_n state;
	#! (marked_symbol,state)
		= state!marked_bool_a.[symbol_offset];
	| marked_symbol || newly_marked_bool_a.[symbol_offset]
		// has already been marked
		= (newly_marked_bool_a,state);


	// unmarked symbol
	| False <<- ("mark (" +++ toString file_n +++ ", hex=" +++ hex_int symbol_n +++ ")")
		= undef;
	
	#! newly_marked_bool_a
		= { newly_marked_bool_a & [symbol_offset] = True };
	| file_n < 0
		= (newly_marked_bool_a,state);
		
	#! (symbol,state) 
		= state!xcoff_a.[file_n].symbol_table.symbols.[symbol_n];

	= selective_symbol_import2 symbol file_n symbol_n (newly_marked_bool_a,state);
where {
	selective_symbol_import2 symbol=:(SectionLabel section_n label_offset) _ _ (newly_marked_bool_a,state)
		#! (section_symbol_n,state)
			= replace_section_label_by_label symbol file_n symbol_n state;
		= selective_import_symbol file_n section_symbol_n (newly_marked_bool_a,state);

	selective_symbol_import2 (Module c1 length virtual_address c2 n_relocations relocations) _ _ s
		| False <<- ("Section")
			= undef;
		= loopAst selective_module_symbol_import s n_relocations;
	where {
		selective_module_symbol_import relocation_n (newly_marked_bool_a,state)
			#! relocation_index
				= relocation_n * SIZE_OF_RELOCATION;
			#! relocation_type
				= relocations IWORD (relocation_index+8);
			#! relocation_symbol_n
				= relocations ILONG (relocation_index+4);
			#! relocation_offset
				= relocations ILONG relocation_index;
				
			# (newly_marked_bool_a,state)
				= what_linker (newly_marked_bool_a,state) (case (((relocation_offset-virtual_address) + 4) == length) of {
					// copy&paste from mark_used_modules (pdSymbolTable)
					// when will this jump be inserted?
					_ 
						-> (newly_marked_bool_a,state);
					
					True
						#! (symbol_offset,state)
							= symbol_n_to_offset file_n relocation_symbol_n state;
						#! (marked_symbol,state)
							= state!marked_bool_a.[symbol_offset];
						| marked_symbol && relocation_type == REL_ABSOLUTE
					/*
						#! module_n
							= symbol_n;		
						#! (first_symbol_n, marked_offset_a) 
							= marked_offset_a![file_n];
						#! bool_offset
							=first_symbol_n + relocation_symbol_n;
						|  already_marked_bool.[bool_offset] //&& relocation_type == REL_ABSOLUTE
							// There is a reference from an (yet) unlinked module to another already linked module. If the unlinked
							// module does not contain an jump instruction at its end, one has to be generated. Accessing the file
							// is expensive. Therefore the worst is assumed: there is a non-jump in which case one has to be 
							// generated.
							/*
							#! updated_relocations
								= WriteLong { c \\ c <-: relocations} relocation_index (relocation_offset + 5) +++ "1"; 
								
							#! updated_module_symbol
								= Module c1 (length + 5) virtual_address c2 /*(inc n_relocations)*/ n_relocations updated_relocations;
							*/
							
							#! (module_name,xcoff_a)
								= xcoff_a![file_n].module_name;
							
							/*			
							#! xcoff_a
								= upd_symbol updated_module_symbol file_n module_n xcoff_a;
							*/
							| relocation_type == REL_ABSOLUTE
								// in this case an extra jump should be generated because the module does not end on one. The
								// relocation type should probably be changed into REL_REL32. The above code should be valid.
								-> abort "pdSymbolTable: jmp problem; please report immediately martijnv@cs.kun.nl";
							
								-> F ("<"+++ module_name +++">danger (if not jmp): file_n: " +++ toString file_n +++ " module_n: " +++ hex_int module_n +++ " - " +++ hex_int relocation_symbol_n) (marked_offset_a,xcoff_a);
							-> F ("!potential danger: file_n: " +++ toString file_n +++ " module_n: " +++ hex_int module_n +++ " - " +++ hex_int relocation_symbol_n) (marked_offset_a,xcoff_a);				
				*/
							-> abort "DynamicLinker; ObjectToMem; internal error";
							-> (newly_marked_bool_a,state);
										
					_
						-> (newly_marked_bool_a,state); 
						
				
					}
				);

			= selective_import_symbol file_n relocation_symbol_n (newly_marked_bool_a,state);
	};
	
	selective_symbol_import2 (ImportLabel label_name) import_label_file_n import_label_symbol_n (newly_marked_bool_a,state)
		#! (imported_symbol_found,imported_file_n,imported_symbol_n,state)
			= find_name4 label_name state;
		| imported_symbol_found // <<- ("selective_symbol_import2", label_name)
			#! state
				= { state & 
					xcoff_a.[import_label_file_n].symbol_table.symbols.[import_label_symbol_n] 
					= ImportedLabel imported_file_n imported_symbol_n
				};

			// ImportedLabel is immediately replaced by a SectionLabel or Label
			= import_an_import_label imported_file_n imported_symbol_n import_label_file_n import_label_symbol_n (newly_marked_bool_a,state);
			
		#! (imp_prefix_found,i)
			= starts "__imp_" label_name
		| fst (starts "__imp_" label_name)
			#! imported_label_name
				= label_name % (i,dec (size label_name));
			#! (imported_label_name_found,imported_file_n,imported_symbol_n,state)
				= find_name4 imported_label_name state;
			| imported_label_name_found
				| imported_file_n < 0
					#! state
						= { state & 
							xcoff_a.[import_label_file_n].symbol_table.symbols.[import_label_symbol_n] 
							= ImportedFunctionDescriptor imported_file_n imported_symbol_n
						};
					= import_an_import_label imported_file_n imported_symbol_n import_label_file_n import_label_symbol_n (newly_marked_bool_a,state);
					
					// a __imp_-prefixed label name *must* be defined in a dynamic linker library
					= abort "a __imp_-prefixed label name *must* be defined in a dynamic linker library";
				
				= report_undefined_symbol newly_marked_bool_a state;
			= report_undefined_symbol newly_marked_bool_a state;
	where {
		report_undefined_symbol newly_marked_bool_a state
			#! msg
				= "undefined symbol '" +++ label_name +++ "'"
			#! state
				= AddMessage (LinkerError msg) state;
			= (newly_marked_bool_a,state);
	};

	selective_symbol_import2 (ImportedLabel imported_file_n imported_symbol_n) import_label_file_n import_label_symbol_n (newly_marked_bool_a,state)
		= import_an_import_label imported_file_n imported_symbol_n import_label_file_n import_label_symbol_n (newly_marked_bool_a,state);

	selective_symbol_import2 (ImportedLabelPlusOffset imported_file_n imported_symbol_n _) _ _ s
		= selective_import_symbol imported_file_n imported_symbol_n s;

	selective_symbol_import2 (ImportedFunctionDescriptor imported_file_n imported_symbol_n) _ _ s
		= selective_import_symbol imported_file_n imported_symbol_n s;
	selective_symbol_import2 s _ _ _
		= abort ("selective_symbol_import2 does not match; " +++ toString s);
		
		/*
	= Module !Int !Int !Int !Int !Int !String		//  offset length virtual_address file_offset n_relocations relocations
	| Label !Int !Int !Int								// section_n offset module_n
	| SectionLabel !Int !Int							// section_n offset
*/		
		
};

import_an_import_label /* symbol to be imported */ imported_file_n imported_symbol_n /* import site */ import_label_file_n import_label_symbol_n (newly_marked_bool_a,state)
	| imported_file_n < 0
		= selective_import_symbol imported_file_n imported_symbol_n (newly_marked_bool_a,state);
	#! state
		= replace_imported_label_symbol /* symbol to be imported */ imported_file_n imported_symbol_n /* import site */ import_label_file_n import_label_symbol_n state;
	= selective_import_symbol imported_file_n imported_symbol_n (newly_marked_bool_a,state);
where {
	replace_imported_label_symbol /* symbol to be imported */ imported_file_n imported_symbol_n /* import site */ import_label_file_n import_label_symbol_n state
		#! (imported_symbol,state) 
			= state!xcoff_a.[imported_file_n].symbol_table.symbols.[imported_symbol_n];
		#! state
			= case imported_symbol of {
				SectionLabel section_n v_label_offset
					#! (section_symbol_n,state)
						= state!xcoff_a.[imported_file_n].symbol_table.section_symbol_ns.[section_n];
					#! (module_symbol,state) 
						= state!xcoff_a.[imported_file_n].symbol_table.symbols.[section_symbol_n];
					-> case module_symbol of {
						Module v_module_offset _ _ _ _ _
							#! state
								= { state & 
									xcoff_a.[import_label_file_n].symbol_table.symbols.[import_label_symbol_n] 
									= ImportedLabelPlusOffset imported_file_n section_symbol_n (v_label_offset-v_module_offset)
								};
							-> state;
						_
							-> state;
						};
				Label _ v_label_offset module_n
				//	at an earlier point in time, mark_used_modules has already converted a Section-
				//	Label into a Label. Re-implements a part of the SectionLabel-case.
					#! (module_symbol,state) 
						= state!xcoff_a.[imported_file_n].symbol_table.symbols.[module_n];
					-> case module_symbol of {
						Module v_module_offset _ _ _ _ _
							#! state
								= { state & 
									xcoff_a.[import_label_file_n].symbol_table.symbols.[import_label_symbol_n] 
									= ImportedLabelPlusOffset imported_file_n module_n (v_label_offset-v_module_offset)
								};
							-> state;
						_
							-> state;
						};	
				_ 
					-> state;
			};
		= state;
}; // import_an_import_label