implementation module State;

import
	StdEnv;
	
import
	SymbolTable, /*PmDynamic,*/ pdState, LinkerMessages;
	
//import 
//	DebugUtilities;
import RWSDebugChoice;	
import Redirections;

:: *State = {
	// misc
		one_pass_link		:: !Bool
	,	normal_static_link	:: !Bool
	,	linker_messages_state:: !LinkerMessagesState
	
	// linker tables
	,	application_name	:: !String
	,	n_libraries			:: !Int
	,	n_xcoff_files 		:: !Int
	,	n_xcoff_symbols		:: !Int
	,	n_library_symbols	:: !Int
	
	,	marked_bool_a		:: !*{#Bool}
	,	marked_offset_a		:: !*{#Int}
	,	module_offset_a		:: !*{#Int}
	,	xcoff_a 			:: !*{#*Xcoff}
	,	namestable			:: !*NamesTable

	// dynamic libraries
	,	library_list 		:: !LibraryList
	,	library_file_names	:: [String]
	
	,	pd_state			:: !*PDState
	
	, 	st_redirection_state	:: !*RedirectionState
};
	
EmptyState :: !*State;
EmptyState = { 
		one_pass_link		= True
	,	normal_static_link	= True
	,	linker_messages_state= DefaultLinkerMessages
	
	// linker tables
	,	application_name	= ""
	,	n_libraries			= 0
	,	n_xcoff_files 		= 0
	,	n_xcoff_symbols		= 0
	,	n_library_symbols	= 0
	,	marked_bool_a		= {}
	,	marked_offset_a		= {}
	,	module_offset_a		= {}
	,	xcoff_a 			= {}
	,	namestable			= create_names_table
	
	// dynamic libraries
	,	library_list 		= EmptyLibraryList
	,	library_file_names	= []
	
	,	pd_state			= DefaultPDState
	
	,	st_redirection_state	= default_redirection_state
};

// xcoff_a access
app_xcoff_a :: (!{#*Xcoff} -> !{#*Xcoff}) !*State -> !*State;
app_xcoff_a  f state=:{xcoff_a}
	= { state & xcoff_a = f xcoff_a };
	
acc_xcoff_a :: (!{#*Xcoff} -> (!.x,!{#*Xcoff})) !*State -> (!.x,!*State);
acc_xcoff_a f state=:{xcoff_a}
	#! (x,xcoff_a)
		= f xcoff_a;
	= (x,{ state & xcoff_a = xcoff_a });

selacc_xcoff :: !Int (!*Xcoff -> (!.x,!*Xcoff)) !*State -> (!.x,!*State);
selacc_xcoff i f state=:{xcoff_a}
	#! (xcoff,xcoff_a)
		= replace xcoff_a i empty_xcoff;
	#! (x,xcoff)
		= f xcoff;
	= (x,{state & xcoff_a = {xcoff_a & [i] = xcoff}});


selapp_xcoff :: !Int (!*Xcoff -> !*Xcoff) !*State -> !*State;
selapp_xcoff i f state=:{xcoff_a}
	#! (xcoff,xcoff_a)
		= replace xcoff_a i empty_xcoff;
	= {state & xcoff_a = {xcoff_a & [i] = f xcoff}};
	
// xcoff_a; symbol_table access
selacc_symbol_table :: !Int (!*SymbolTable -> (!.x,!*SymbolTable)) !*State -> (!.x,!*State);
selacc_symbol_table i f state
		= selacc_xcoff i w1 state;
where {
//	w1 :: !*Xcoff -> (!.x,!*Xcoff);
	w1 xcoff=:{symbol_table}
		#! (x,symbol_table)
			= f symbol_table;
		= (x, {xcoff & symbol_table = symbol_table})
}

selapp_symbol_table :: !Int (!*SymbolTable -> !*SymbolTable) !*State -> !*State;
selapp_symbol_table i f state
	= selapp_xcoff i w2 state;
where {
	w2 :: !*Xcoff -> !*Xcoff;
	w2 xcoff=:{symbol_table}
		= {xcoff & symbol_table = f symbol_table};
}

// symbols
selacc_symbols :: !Int (!*SymbolArray -> (!.x,!*SymbolArray)) !*State -> (!.x,!*State);
selacc_symbols file_n  f state
		= selacc_symbol_table file_n w3 state;
where { 
//	w3 :: !*SymbolTable -> (!Symbol,!*SymbolTable);
	w3 symbol_table=:{symbols}
		#! (x,symbols)
			= f symbols;
		= (x, {symbol_table & symbols = symbols} );
}

selapp_symbols :: !Int (!*SymbolArray -> *SymbolArray) !*State -> !*State;
selapp_symbols file_n f state
	= selapp_symbol_table file_n w4 state;
where {
	w4 :: !*SymbolTable -> !*SymbolTable;
	w4 symbol_table=:{symbols}
		= {symbol_table & symbols = f symbols};
}
	
/*
** applied transformation: elimination of currying
*/
sel_symbol file_n symbol_n state :== sel_symbol file_n symbol_n state
where { 	
	//sel_symbol :: !Int !Int !*State -> (!Symbol,!*State);
	sel_symbol file_n symbol_n state
//		| True <<- ("sel_symbol",file_n,symbol_n)
		= state!xcoff_a.[file_n].symbol_table.symbols.[symbol_n];
}


class UpdateSymbol a
where {
	upd_symbol :: !Symbol !Int !Int !*a -> !*a
};

instance UpdateSymbol State 
where {
	upd_symbol symbol file_n symbol_n state
		= update_symbol symbol file_n symbol_n state
};

//1.3
instance UpdateSymbol !{#*Xcoff}
//3.1
/*2.0
instance UpdateSymbol {#*Xcoff}
0.2*/
where {
	upd_symbol symbol file_n symbol_n xcoff_a
		| file_n < 0
			= abort "update_symbol: not a dll";
			= { xcoff_a & [file_n].symbol_table.symbols.[symbol_n] = symbol };
};



update_symbol :: !Symbol !Int !Int !State -> !State;
update_symbol symbol file_n symbol_n state //=:{xcoff_a}
	| file_n < 0
		= abort "update_symbol: not a dll";
		= { state & xcoff_a.[file_n].symbol_table.symbols.[symbol_n] = symbol };

// marked_bool_a access
acc_marked_bool_a :: (!*{#Bool} -> (!.x,!*{#Bool})) !*State -> (!.x,!*State);
acc_marked_bool_a f state=:{marked_bool_a} 
	#! (x,marked_bool_a)
		= f marked_bool_a;
	= (x,{state & marked_bool_a = marked_bool_a});
	
selacc_marked_bool_a :: !Int !*State -> (!Bool,!*State);
selacc_marked_bool_a i state
	= state!marked_bool_a.[i];
	
// module_offset_a access
acc_module_offset_a :: (!*{#Int} -> (!.x,!*{#Int})) !*State -> (!.x,!*State);
acc_module_offset_a f state=:{module_offset_a} 
	#! (x,module_offset_a)
		= f module_offset_a;
	= (x,{state & module_offset_a = module_offset_a});
	
app_module_offset_a :: (!*{#Int} -> !*{#Int}) !*State -> !*State;
app_module_offset_a f state=:{module_offset_a}	
	= { state & module_offset_a = f module_offset_a };
	
selacc_module_offset_a :: !Int !*State -> (!Int,!*State);
selacc_module_offset_a i state
	= state!module_offset_a.[i];
//	= acc_module_offset_a (\module_offset_a=:{[i] = index} -> (index,module_offset_a)) state;
		
// marked_offset_a access
acc_marked_offset_a :: (!*{#Int} -> (!.x,!*{#Int})) !*State -> (!.x,!*State);
acc_marked_offset_a f state=:{marked_offset_a} 
	#! (x,marked_offset_a)
		= f marked_offset_a;
	= (x,{state & marked_offset_a = marked_offset_a});
	
selacc_marked_offset_a :: !Int !*State -> (!Int,!*State);
selacc_marked_offset_a i state
	= state!marked_offset_a.[i];
//	= acc_marked_offset_a (\marked_offset_a=:{[i] = index} -> (index,marked_offset_a)) state;
	
selacc_so_marked_offset_a :: !Int !*State -> (!Int,!*State);
selacc_so_marked_offset_a file_n state
//	| file_n >= 0
//		= abort ("selacc_so_marked_offset_a: i should be negative to indicate a shared library (or dll): ");
		
		#! (s_marked_offset_a,state)
			= acc_marked_offset_a usize state;
		= selacc_marked_offset_a (file_n + s_marked_offset_a) state;
		
// namestable access
app_namestable :: (!*NamesTable -> !*NamesTable) !*State -> !*State;
app_namestable f state=:{namestable}
	= { state & namestable = (f namestable) };

acc_namestable :: (!*NamesTable -> (!.x,!*NamesTable)) !*State -> (!.x,!*State);
acc_namestable f state=:{namestable}
	#! (x,namestable)
		= f namestable;
	= (x, { state & namestable = namestable } );

// General
select_namestable state					:== acc_namestable (\namestable -> (namestable,{})) state;

update_namestable :: NamesTable !State -> State;
update_namestable namestable state
	= {state & namestable = namestable};
	
select_marked_bool_a :: !State -> (!*{#Bool},!State);
select_marked_bool_a state=:{marked_bool_a}
	= (marked_bool_a,{state & marked_bool_a = {}});

select_marked_offset_a :: !State -> (!*{#Int},!State);
select_marked_offset_a state=:{marked_offset_a}
	= (marked_offset_a,{state & marked_offset_a = {}});
	
select_module_offset_a :: !State -> (!*{#Int},!State);
select_module_offset_a state=:{module_offset_a}
	= (module_offset_a,{state & module_offset_a = {}});
	
select_xcoff_a :: !State -> (!{#*Xcoff},!State);
select_xcoff_a state=:{xcoff_a}
	= (xcoff_a,{state & xcoff_a = {}});
	
update_state_with_xcoff :: !*Xcoff !State -> !State;
update_state_with_xcoff xcoff state=:{xcoff_a,n_xcoff_files}
	= {state & xcoff_a = fill_xcoff_array xcoff 0 n_xcoff_files xcoff_a (xcoff_array (n_xcoff_files+1)) };
{
	xcoff_array :: !Int -> !*{#*Xcoff};
	xcoff_array n = {empty_xcoff \\ i<-[0..dec n]};
	
	fill_xcoff_array :: *Xcoff !Int !Int !*{#*Xcoff} !*{#*Xcoff} -> !*{#*Xcoff};
	fill_xcoff_array xcoff i n_xcoff_files old_xcoff_a new_xcoff_a
		| i == n_xcoff_files
			= {new_xcoff_a & [n_xcoff_files] = xcoff};
			
			#! (old_xcoff,old_xcoff_a1) 
				= replace old_xcoff_a i empty_xcoff;
			= fill_xcoff_array xcoff (inc i) n_xcoff_files old_xcoff_a1 {new_xcoff_a & [i] = old_xcoff};
}



find_name :: !String !State -> (!Int,!Int,!State);
find_name name state 
	#! (namestable,state)
		= select_namestable state;
	#! (names_table_element,namestable)
		= find_symbol_in_symbol_table name namestable
	#! state
		= update_namestable namestable state;
	
	= case names_table_element of {
		(NamesTableElement _ symbol_n file_n _)
			-> (file_n,symbol_n,state);
		_
			-> abort ("find_name: name not found" +++ name );
	  };

address_of_label2 :: !Int !Int !State -> (!Int,!State);
address_of_label2 file_n symbol_n state
	#! (first_symbol_n,state1)
		= selacc_marked_offset_a file_n state1;
	#! (marked,state1)
		= selacc_marked_bool_a (first_symbol_n+symbol_n) state1;
	| not marked 
		= (0,state1);
		
//		#! (label_symbol,state)
//			= sel_symbol file_n symbol_n state;
		| isLabel label_symbol
			#! module_n
				= getLabel_module_n label_symbol;
			#! offset
				= getLabel_offset label_symbol;
				
			#! (module_symbol,state1)
				= sel_symbol file_n module_n state1;
			| isModule module_symbol
				#! virtual_label_offset
					= getModule_virtual_label_offset module_symbol;
				#! (first_symbol_n,state1) 
					= selacc_marked_offset_a file_n state1;
				#! (real_module_offset,state1)
					= selacc_module_offset_a (first_symbol_n + module_n) state1;
				= (real_module_offset+offset-virtual_label_offset,state1);

				= abort "address_of_label2: internal error (isModule)";
		| isModule label_symbol
			= (sel_platform address_of_label2_pc address_of_label2_mac) state1;
			= abort "address_of_label2: not a {label,module}-symbol";
where {
	(label_symbol,state1)
		= sel_symbol file_n symbol_n state;
		
	address_of_label2_pc state
		#! module_n
			= symbol_n;
		#! module_symbol
			= label_symbol;
			
		#! virtual_label_offset
			= getModule_virtual_label_offset module_symbol;
		#! (first_symbol_n,state) 
			= selacc_marked_offset_a file_n state;
		#! (real_module_offset,state)
			= selacc_module_offset_a (first_symbol_n + module_n) state;
			
		#! q = real_module_offset-virtual_label_offset;
		= (q,state);
		
	address_of_label2_mac state
		#! module_n
			= symbol_n;
		#! module_symbol
			= label_symbol;
			
		#! (first_symbol_n,state) 
			= selacc_marked_offset_a file_n state;
		#! (real_module_offset,state)
			= selacc_module_offset_a (first_symbol_n + module_n) state;
		= (real_module_offset,state);

} // address_of_label2

find_address_of_label :: !String !State -> !(!Bool,!Int,!State);
find_address_of_label label state
	#! (ok,file_n,label_n,state)
		= find_name2 label state;
	| not ok
		= (False,0,state);
	#! (addr,state)
		= address_of_label2 file_n label_n state;
	= (True,addr,state);
where {
			
/*
			= case label_symbol of {
				Label _ offset module_n
					#! (module_symbol,state)
						= sel_symbol file_n module_n state;
					-> case module_symbol of {
						Module _ virtual_label_offset _ _ _ _ _
							#! (first_symbol_n,state) 
								= selacc_marked_offset_a file_n state;
							#! (real_module_offset,state)
								= selacc_module_offset_a (first_symbol_n + module_n) state;
							-> (real_module_offset+offset-virtual_label_offset,state);
						_
							-> abort "address of label2: error";
					   }
		  	}
*/
		  	


} // find_address_of_label

find_name2 :: !String !State -> (!Bool,!Int,!Int,!State);
find_name2 name state 
	#! (namestable,state)
		= select_namestable state;
	#! (names_table_element,namestable)
		= find_symbol_in_symbol_table name namestable;
	#! state
		= update_namestable namestable state;
	
	= case names_table_element of {
		(NamesTableElement _ symbol_n file_n _)
			-> (True,file_n,symbol_n,state);
		_
			-> (False,0,0,state);
	  };
	  
find_name4 :: !String !State -> (!Bool,!Int,!Int,!State);
find_name4 name state = find_name2 name state;


// General
select_file_name file_n state :== sel_platform 
	(state!xcoff_a.[file_n].file_name)
	// was: (selacc_xcoff file_n (\xcoff=:{file_name} -> (file_name,xcoff)) state)
	(abort "macOS: selecties direkt maken pdSymbolTable)") //(selacc_xcoff file_n sel_file_name state)	
	; 
	
select_module_name file_n state 
	:==  (state!xcoff_a.[file_n].module_name);
//	(selacc_xcoff file_n (\xcoff=:{module_name} -> (module_name,xcoff)) state);
	
// winos specific				
select_n_symbols file_n state :== sel_platform
	(state!xcoff_a.[file_n].n_symbols)
//	(selacc_xcoff file_n (\xcoff=:{n_symbols} -> (n_symbols,xcoff)) state)
	(abort "select_n_symbols (state): macOS");
	
selacc_bss_symbols file_n state :== 
	(state!xcoff_a.[file_n].symbol_table.bss_symbols)
//	sel_platform			
//	(selacc_symbol_table file_n (\symbol_table=:{bss_symbols} -> (bss_symbols,symbol_table)) state)
//	(selacc_symbol_table file_n (\symbol_table=:{bss_symbols} -> (bss_symbols,symbol_table)) state)
	;
	
selacc_data_symbols file_n state :== 
	(state!xcoff_a.[file_n].symbol_table.data_symbols)
//	sel_platform
//	(selacc_symbol_table file_n (\symbol_table=:{data_symbols} -> (data_symbols,symbol_table)) state)
//	(selacc_symbol_table file_n (\symbol_table=:{data_symbols} -> (data_symbols,symbol_table)) state);
	;
		
selacc_text_symbols file_n state :== 
	(state!xcoff_a.[file_n].symbol_table.text_symbols)
//	sel_platform
//	(selacc_symbol_table file_n (\symbol_table=:{text_symbols} -> (text_symbols,symbol_table)) state)
//	(selacc_symbol_table file_n (\symbol_table=:{text_symbols} -> (text_symbols,symbol_table)) state);
	;
	
// macOS specific
// for xcoff:
selacc_text_relocations file_n state :== sel_platform
	(abort "selacc_text_relocations (state): winOS")
	(selacc_xcoff file_n get_text_relocations state);

selacc_data_relocations file_n state :== sel_platform
	(abort "selacc_data_relocations (state): winOS")
	(selacc_xcoff file_n get_data_relocations state);
	
selacc_header file_n state :== sel_platform
	(abort "selacc_header (state): winOS")
	(selacc_xcoff file_n get_header state);
	
selacc_n_symbols file_n state :== sel_platform
	(abort "selacc_n_symbols (state): winOS")
	(selacc_xcoff file_n get_n_symbols state);
	
selacc_text_v_address file_n state 	:== sel_platform
	(abort "selacc_text_v_address (state): winOS")
	(selacc_xcoff file_n get_text_v_address state);
	
selacc_data_v_address file_n state 	:== sel_platform
	(abort "selacc_data_v_address (state): winOS")
	(selacc_xcoff file_n get_data_v_address state);
	
selacc_toc0_symbols file_n state 	:== sel_platform
	(abort "selacc_toc0_symbols (state): winOS")
	(selacc_symbol_table file_n get_toc0_symbols state);
	
selacc_toc_symbols file_n state 	:== sel_platform
	(abort "selacc_toc_symbols (state): winOS")
	(selacc_symbol_table file_n get_toc_symbols state);

is_defined_symbol :: !String !*State -> !(!Bool,!Int,!Int,!*State);
is_defined_symbol symbol_name state
	#! (namestable,state)
		= select_namestable state;
	#! (names_table_element,namestable)
		= find_symbol_in_symbol_table symbol_name namestable;
	#! state
		= update_namestable namestable state;
	= case names_table_element of {
		NamesTableElement _ symbol_n file_n _ 
			-> (True,file_n,symbol_n,state);
		_
			-> (False,0,0,state);
	};
	
strip_linker_message (LinkerError s)	= s;
strip_linker_message (LinkerWarning s)	= s;
strip_linker_message (Verbose s)		= s;
strip_linker_message _					= abort "strip_linker_message";

// ADDED
instance AddMessage State
where {
	AddMessage linker_message state=:{linker_messages_state}
		# linker_messages_state
			= addLinkerMessage linker_message linker_messages_state;
		= {state & linker_messages_state = linker_messages_state};
		
	IsErrorOccured state=:{linker_messages_state}
		#! (ok,linker_messages_state)
	 		= isLinkerErrorOccured linker_messages_state;
		 = (ok,state);
		 
	GetLinkerMessages state=:{linker_messages_state}
		#! messages
			= get_LinkerMessages linker_messages_state;
		= (messages,state);
		
	SetLinkerMessages messages state=:{linker_messages_state}
		#! linker_messages_state
			= setLinkerMessages messages linker_messages_state;
		= {state & linker_messages_state = linker_messages_state};
};

app_pdstate :: (!*PDState -> !*PDState) !*State -> !*State;
app_pdstate f state=:{pd_state}
	#! pd_state
		= f pd_state;
	= { state & pd_state = pd_state };
	
acc_pdstate :: (!*PDState -> (!.x,!*PDState)) !*State -> (!.x,!*State);
acc_pdstate f state=:{pd_state}
	#! (x,pd_state)
		= f pd_state;
	= (x,{ state & pd_state = pd_state});
		

find_name3 :: .Int .Int !*State -> *(.Bool,{#Char},*State);
find_name3 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;
		
}

instance GetPutRedirectionState State
where {
	get_redirection_state state=:{st_redirection_state}
		= (st_redirection_state,{ state & st_redirection_state = default_redirection_state } );
	put_redirection_state redirection_state state
		= { state & st_redirection_state = redirection_state };
};

// for use in marked_bool_a and module_offset_a
class symbol_n_to_offset s :: !.Int !.Int !*s -> *(Int,*s);

instance symbol_n_to_offset State
where {
	symbol_n_to_offset file_n symbol_n state
		#! (first_symbol_n,state)
			= case (file_n < 0) of {
				True	
					#! (s_marked_offset,state)
						= acc_marked_offset_a usize state;
					-> state!marked_offset_a.[s_marked_offset + file_n];
				False
					-> state!marked_offset_a.[file_n];
			};
		#! symbol_index
			= first_symbol_n + symbol_n;
		= (symbol_index,state);
};