implementation module Relocations;

import State, xcoff, ExtString;
import ExtInt;

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;
					-> s;
				REL_DIR32
					-> Nrelocate_long_pos rec_sym 
					state2 
					((relocation_offset-virtual_address) + 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 _ 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);
		};
					
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
	= 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)};