implementation module Relocations;

import State, xcoff, ExtString;

//import DebugUtilities;
import ExtInt;

//linker static dynamic :== dynamic;


relocate_text :: !Int !Int /* end JMP */ !Int !Int !Int !Int !Int !Int !Int !State !*{#Char} !Int !String -> !(!*{#Char},!State);
relocate_text module_n length /* end JMP */ start relocation_n n_relocations file_n virtual_module_offset real_module_offset 
	/* mac: text_relocations data_relocations */
	first_symbol_n 
	state text_a0
	
	// pc specific
	virtual_address
	relocations
	
	|relocation_n == n_relocations
		= (text_a0,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;
			
						
		//
	(rec_sym,state2)
				= sel_symbol file_n relocation_symbol_n state;



			(text1,state3) = case relocation_type of {
				REL_REL32
					# s = Nrelocate_branch rec_sym
						state2 
						relocation_offset 
						((relocation_offset-virtual_address) + /* ADDED */ start)
						virtual_module_offset
						real_module_offset 
						first_symbol_n 
						relocation_symbol_n 
						file_n 
						text_a0;


/*						
					// JMP ...
					# s
						= case (((relocation_offset-virtual_address) + 4) == length) of {
							True
								-> F ("potential danger: file_n: " +++ toString file_n +++ " module_n: " +++ hex_int module_n) s;
							False
								-> s; 
						};
					// ... JMP
*/
					-> s;

/*					 Nrelocate_branch rec_sym
					state2 
					relocation_offset 
					((relocation_offset-virtual_address) + /* ADDED */ start)
					virtual_module_offset
					real_module_offset 
					first_symbol_n 
					relocation_symbol_n 
					file_n 
					text_a0;
*/					
				REL_DIR32
					-> Nrelocate_long_pos rec_sym 
					state2 
					((relocation_offset-virtual_address) + /* ADDED */ start)
					first_symbol_n 
					relocation_symbol_n 
					file_n  
					text_a0;
				REL_ABSOLUTE
					-> (text_a0,state2);
		 
			} // case
			
		= relocate_text module_n length /* end of JMP */ start (inc relocation_n) n_relocations file_n virtual_module_offset real_module_offset first_symbol_n state3 text1 virtual_address relocations;

Nrelocate_branch :: !Symbol !*State !Int !Int !Int !Int !Int !Int !Int !*{#Char} -> (!*{#Char}, !*State); 
Nrelocate_branch (Module  virtual_label_offset _ _ _ _ _) state relocation_offset index virtual_module_offset real_module_offset first_symbol_n symbol_n file_n text0
	#! (real_label_offset,state)
		= selacc_module_offset_a (first_symbol_n + symbol_n ) state;
	= (add_to_long_at_offset (-4+(virtual_module_offset-relocation_offset)+
								 (real_label_offset-real_module_offset)) index text0,
		state);
	
Nrelocate_branch (Label _ /*SK_TEXT*/ offset module_n) state relocation_offset index virtual_module_offset real_module_offset first_symbol_n relocation_symbol_n file_n text0
	#! (symbol,state)
		= sel_symbol file_n module_n state;
	#! (r_offset,state)
		= selacc_module_offset_a (first_symbol_n + module_n) state;
	#! real_label_offset
		= r_offset + offset;
		
	= case symbol of {
		Module virtual_label_offset _ _ _ _ _
			-> (add_to_long_at_offset (-4+(virtual_label_offset-relocation_offset)+
										  (real_label_offset-real_module_offset)) index text0,
				state);
	  };
					
Nrelocate_branch (ImportedLabel file_n symbol_n) state relocation_offset index virtual_module_offset real_module_offset _ relocation_symbol_n current_file_n text0
			
	| file_n < 0
		#! (index1,state)
			= selacc_so_marked_offset_a file_n state;
		#! (real_label_offset,state)
			= selacc_module_offset_a (index1 + symbol_n) state;
		
		= (add_to_long_at_offset (-4+(virtual_module_offset-relocation_offset)+
									 (real_label_offset-real_module_offset)) index text0,
			state);
		
		#! (symbol,state)
			= sel_symbol file_n symbol_n state;
		#! (first_symbol_n,state)
			= selacc_marked_offset_a file_n state;
		#! (real_label_offset,state)
			= selacc_module_offset_a (first_symbol_n + symbol_n) state;
		= case symbol of {
			Module  _ _ _ _ _ _
				-> (add_to_long_at_offset (-4+(virtual_module_offset-relocation_offset)+
											  (real_label_offset-real_module_offset)) index text0,
					state);
/*
			s
				#! (file_name,state)
					= select_file_name file_n state;				
			
				-> abort ("Nrelocate_branch: " +++ toString symbol +++ " - " +++ toString file_n +++ "referencing from file '" +++ file_name +++ "'" +++ toString symbol_n);
*/
		};
					
Nrelocate_branch (ImportedLabelPlusOffset file_n1 symbol_n1 label_offset) state relocation_offset index virtual_module_offset real_module_offset _ relocation_symbol_n _ text0
	#! (symbol1,state)
		= sel_symbol file_n1 symbol_n1 state;
	#! (first_symbol_n,state)
		= selacc_marked_offset_a file_n1 state;
	#! (real_label_offset,state)
		= selacc_module_offset_a (first_symbol_n + symbol_n1) state;
	= case symbol1 of {
		Module  _ _ _ _ _ _
				-> (add_to_long_at_offset (-4+(virtual_module_offset-relocation_offset)+
											  (real_label_offset-real_module_offset)
											  +label_offset) index text0,
					state);
	  };
	  
Nrelocate_branch s state relocation_offset index virtual_module_offset real_module_offset _ relocation_symbol_n _ text0
	| True <<- s
	= abort "Nrelocate_branch";
			

// absolute relocations
Nrelocate_long_pos :: !Symbol !*State !Int !Int !Int !Int !*{#Char} -> (!*{#Char},!*State);
Nrelocate_long_pos (Module  virtual_label_offset _ _ _ _ _) state index first_symbol_n symbol_n _ data0
	#! (real_label_offset,state)
		= selacc_module_offset_a (first_symbol_n + symbol_n) state;
	= (add_to_long_at_offset real_label_offset index data0,state);
		
Nrelocate_long_pos (Label _ offset module_n) state index first_symbol_n symbol_n file_n data0	  	
	#! (symbol,state)
		= sel_symbol file_n module_n state;
	#! (real_label_offset,state)
		= selacc_module_offset_a (first_symbol_n + module_n) state;
	= case symbol of {
		Module  virtual_label_offset _ _ _ _ _
			-> (add_to_long_at_offset (real_label_offset+offset-virtual_label_offset) index data0 ,
				state);
		};
	  
Nrelocate_long_pos (ImportedLabel file_n symbol_n) state index _ /* first_symbol_n */ _ cfile_n data0	  	
	| file_n<0	
		#! (index1,state)
			= selacc_so_marked_offset_a file_n state;
		#! (real_label_offset,state)
			= selacc_module_offset_a (index1 + symbol_n) state;
		= (add_to_long_at_offset real_label_offset index data0, state);
		 
		#! (symbol, state) 
			= sel_symbol file_n symbol_n state;
		#! (first_symbol_n, state) 
			= selacc_marked_offset_a file_n state; 
		#! (real_label_offset, state)
			= selacc_module_offset_a (first_symbol_n+symbol_n) state;
		= case symbol of {
			Module  _ _ _ _ _ _
				-> (add_to_long_at_offset real_label_offset index data0,
					 state);
			};

Nrelocate_long_pos (ImportedLabelPlusOffset file_n symbol_n label_offset) state index /* first_symbol_n*/ _ _ _ data0	  	
	#! (symbol, state) 
		= sel_symbol file_n symbol_n state;
	#! (first_symbol_n, state) 
		= selacc_marked_offset_a file_n state; 
	#! (real_label_offset, state)
		= selacc_module_offset_a (first_symbol_n+symbol_n) state;
	= case symbol of {
		Module  _ _ _ _ _ _
			-> (add_to_long_at_offset (real_label_offset+label_offset) index data0,
				 state);
		};
		
Nrelocate_long_pos (ImportedFunctionDescriptor file_n symbol_n) state index first_symbol_n _ _ data0
	| file_n < 0
		#! (index1, state)
			= selacc_so_marked_offset_a file_n state;
		#! (real_label_offset, state)
			= selacc_module_offset_a (index1 + symbol_n + 1) state;
		= (add_to_long_at_offset real_label_offset index data0,
				 state); 
				 
Nrelocate_long_pos s state index first_symbol_n symbol_n _ data0
	| True <<- s
	= abort "Nrelocate_long_pos (Module  virtual_label_offset _ _ _ _ _) state index first_symbol_n symbol_n _ data0";
	

add_to_long_at_offset :: !Int !Int !*{#Char} -> !*{#Char};
add_to_long_at_offset w index array
	#!	index1 = index+1;
		index2 = index+2;
		index3 = index+3;
		
	#! (v0,array)
		= array![index]
	#! (v1,array)
		= array![index1]
	#! (v2,array)
		= array![index2]
	#! (v3,array)
		= array![index3]
		
	#! v = (toInt v0)+(toInt v1<<8)+(toInt v2<<16)+(toInt v3<<24);

	#! new_v
		= v + w;

	= {array & [index]=toChar new_v,[index1]=toChar (new_v>>8),[index2]=toChar (new_v>>16),[index3]=toChar (new_v>>24)};



/*
add_to_long_at_offset :: !Int !Int !*{#Char} -> !*{#Char};
add_to_long_at_offset w index array=:{[index]=v0,[index1]=v1,[index2]=v2,[index3]=v3}
	= {array & [index]=toChar new_v,[index1]=toChar (new_v>>8),[index2]=toChar (new_v>>16),[index3]=toChar (new_v>>24)};
	{		
		new_v= v+w;
		
		v = (toInt v0)+(toInt v1<<8)+(toInt v2<<16)+(toInt v3<<24);

		index1 = index+1;
		index2 = index+2;
		index3 = index+3;
		
//		index11 = index-1;
	}	
*/

// ADDED ...
find_name2 file_n relocation_symbol_n state
	#! (names_table,state)
		= select_namestable state;
	#! (s_names_table,names_table)
		= usize names_table;
		
	#! (found,name,names_table)
		= search 0 s_names_table names_table
	#! state
		= update_namestable names_table state;
	= (found,name,state);
where {
	search i limit names_table
		| i == limit
			= (False,"",names_table);

		#! (names_table_element,names_table)
			= names_table![i];
		#! (found,name)
			= search_in_names_table names_table_element;
		| not found
			= search (inc i) limit names_table;

			= (found,name,names_table);
	
	search_in_names_table EmptyNamesTableElement
		= (False,"");
	search_in_names_table (NamesTableElement name n_symbol_n n_file_n rest)
		| n_symbol_n == relocation_symbol_n && n_file_n == file_n
			= (True,name);
		= search_in_names_table rest;
		
}
// ... ADDED