implementation module ObjectToMem;

import
	StdEnv;
	
//import DLState;
import UnknownModuleOrSymbol;

// Extension to library 0.8.1
//import ExtFile_IO081;

import SearchObject;
import ExtFile;
import ExtInt;
import DynamicLink;
//import DebugUtilities;
F a b :== b;



import CommonObjectToDisk;
//import  DynamicLinkerOffsets; // import Dcompute_imported_library_symbol_offsets;
//import LinkerOffsets;
//import lib;
//import IdataSection;
//import ReadObject;
//import ExtFile_IO081;
//import ReadObject;
import pdObjectToMem;

//1.3
from ReadObject import read_library_file, ExtFileSystem, read_library_file_new;
from deltaIOState import FileEnv;
import what_linker;
//3.1
/*2.0
from ReadObject import read_library_file, class ExtFileSystem, instance ExtFileSystem Files, read_library_file_new;
from deltaIOState import class FileEnv, instance FileEnv (IOState s);
import what_linker;
from pdObjectToMem import instance SendAddressToClient Int;
0.2*/

import xcoff;

from UtilStrictLists import StrictListToList;

/*
/*
	NewLinkerFunction3
	
	precondition:
	an undefined module in the unknown_modules_or_symbols-list never has the .abc or .o
	extension.
*/
NewLinkerFunction3 :: ![!ModuleOrSymbolUnknown] !*DLClientState !*DLServerState !*(IOState *DLServerState) -> !*(!Bool,![!Int],!*DLClientState,!*DLServerState,!*IOState !*DLServerState);
NewLinkerFunction3 unknown_modules_or_symbols dl_client_state=:{id=client_id,app_linker_state} dl_server_state io
	
	// load modules
	#! (ok,app_linker_state,dl_client_state,dl_server_state,io)
		= load_modules2 unknown_modules_or_symbols app_linker_state { dl_client_state & app_linker_state = EmptyState } dl_server_state io;
	| not ok
		= (False,[],{dl_client_state & app_linker_state = app_linker_state},dl_server_state,io);
		

	// all symbolic references have been resolved; link and write code
	#! ((symbol_addresses,app_linker_state),io)
		= /*accFiles*/ LinkUnknownSymbols unknown_modules_or_symbols app_linker_state io;

	#! (ok,app_linker_state)
		= IsErrorOccured app_linker_state;
	| not ok
		= (False,[],{dl_client_state & app_linker_state = app_linker_state},dl_server_state,io);
		
	#! s_symbol_addresses		
		= foldl (\s i -> s +++ (FromIntToString i)) "" symbol_addresses;
		
	#! io
		= SendAddressToClient client_id s_symbol_addresses io;
	
//	| ReplyReqS s_symbol_addresses
		= (True,symbol_addresses,{dl_client_state & app_linker_state = app_linker_state},dl_server_state,io);
*/

/*
instance SendAddressToClient [Int]
where {
	SendAddressToClient _ symbol_addresses io
		#! s
			= foldl (\s i -> s +++ (FromIntToString i)) "" symbol_addresses;
		| ReplyReqS s
			= io;
};
*/

/*
	NewLinkerFunction2
	
	precondition:
	an undefined module in the unknown_modules_or_symbols-list never has the .abc or .o
	extension.
*/
//NewLinkerFunction2 :: ![!ModuleOrSymbolUnknown] !*DLClientState !*DLServerState !*(IOState *DLServerState) -> !*(!Bool,![!Int],!*DLClientState,!*DLServerState,!*IOState !*DLServerState);
NewLinkerFunction2 unknown_modules_or_symbols dl_client_state dl_server_state io
	:== NewLinkerFunction2a True unknown_modules_or_symbols dl_client_state dl_server_state io;
	

NewLinkerFunction2a :: !Bool [ModuleOrSymbolUnknown] !*DLClientState !*DLServerState !*(IOState *DLServerState) -> !*(!Bool,[Int],!*DLClientState,!*DLServerState,!*IOState !*DLServerState);
NewLinkerFunction2a send_addresses unknown_modules_or_symbols dl_client_state=:{id=client_id,app_linker_state} dl_server_state io
//NewLinkerFunction2a send_addresses [x,xs] dl_client_state=:{id=client_id,app_linker_state} dl_server_state io
//	# unknown_modules_or_symbols = [x]
	// load modules
	#! (ok,app_linker_state,dl_client_state,dl_server_state,io)
		= load_modules2 unknown_modules_or_symbols app_linker_state { dl_client_state & app_linker_state = EmptyState } dl_server_state io;
	| not ok
		= (False,[],{dl_client_state & app_linker_state = app_linker_state},dl_server_state,io);
		
		
//	| True
//		= abort "ok";
		
	// all symbolic references have been resolved; link and write code
	#! ((wii,symbol_addresses,app_linker_state,dl_client_state),io)
		= /*accFiles*/ LinkUnknownSymbols unknown_modules_or_symbols app_linker_state (-1) dl_client_state io;
	#! (ok,app_linker_state)
		= IsErrorOccured app_linker_state;
	| not ok
		= (False,[],{dl_client_state & app_linker_state = app_linker_state},dl_server_state,io);

/*	
OLD: made an instance SendAddressToClient which is capable of sending a list of integers	
	#! s_symbol_addresses		
		= foldl (\s i -> s +++ (FromIntToString i)) "" symbol_addresses;
*/
		
	#! io
		= case send_addresses of {
			True
				-> SendAddressToClient client_id symbol_addresses io;
			False
				-> io;
		};
		
	#! dl_client_state
		= case wii of {
			Nothing
				-> dl_client_state;
			Just {wii_code_start,wii_code_end,wii_data_start,wii_data_end}
				#! (cs_main_library_instance_i,dl_client_state)
					= dl_client_state!cs_main_library_instance_i;
				#! library_instance_i
					= fromJust cs_main_library_instance_i;
					
					// DLClientState
				#! (li_memory_areas,dl_client_state)
					= dl_client_state!cs_library_instances.lis_library_instances.[library_instance_i].li_memory_areas;
				#! li_memory_areas
					= [{ma_begin=wii_data_start,ma_end=wii_data_end},{ma_begin=wii_code_start,ma_end=wii_code_end}:li_memory_areas];
				#! dl_client_state
					= { dl_client_state &
						cs_library_instances.lis_library_instances.[library_instance_i].li_memory_areas = li_memory_areas
					};
				-> dl_client_state;
		};

	
//	| ReplyReqS s_symbol_addresses
		= (True,symbol_addresses,{dl_client_state & app_linker_state = app_linker_state},dl_server_state,io);
	
// SymbolUnknown name_of_referencing_module label_name)	

// lazily linked application	
InitialLink2 :: /*!String*/ !*DLClientState !*DLServerState !*(IOState *DLServerState) -> !*(!Int,!*DLClientState,!*DLServerState,!*IOState !*DLServerState);
InitialLink2 /*options_file_name*/ dl_client_state=:{id=client_id,project,app_linker_state=state} dl_server_state io
	// settings
	#! dl_client_state 
		= {dl_client_state & app_linker_state = EmptyState};
	#! main_symbol
		= sel_platform "_mainCRTStartup" "main";
	#! psi
		= (fst (getStaticInfo project));
		
	// winos; MOVE TO ObjectToMem.icl; InitialLink2
	#! ((options_file_name,dl_client_state,dl_server_state),io)
		= sel_platform 
			(accFiles (generate_options_file dl_client_state dl_server_state) io)
			(("",dl_client_state,dl_server_state),io)
			;

	#! (ok,dl_client_state)
		= IsErrorOccured dl_client_state;
	| not ok
		= (0,dl_client_state,dl_server_state,io);
//		= (False,client_id,AddToDLServerState dl_client_state dl_server_state,io);

	// generate list of unknown modules from project	
	#! object_files 
		= StrictListToList psi.stat_objs;
	#! static_library_files
		= StrictListToList psi.stat_slibs;
	#! unknown_modules
		= [ ModuleUnknown (strip_abc_and_o_extension object_file) "" \\ object_file <- (object_files ++ (sel_platform [options_file_name:static_library_files] []) )];

	
	// fetch dynamic libraries (*_library)
	#! library_files
		= StrictListToList psi.stat_dlibs;

	// temp for mac
	#! (dl_client_state,unknown_modules,library_files,state)
		= case (sel_platform True False) of {
			True
				// winOs
				-> (dl_client_state,unknown_modules,library_files,state);
			False
 /*
				// macOs
				#! (object_file_names,library_file_names,executable)
					= objects_and_libraries;
				#! state
					= AddMessage (LinkerWarning ("using hard-coded application '" +++ executable +++ "'")) state;
				-> (dl_client_state,[ModuleUnknown (strip_abc_and_o_extension object_file) "" \\ object_file <- object_file_names],library_file_names,state);
 */
				-> abort "ObjectToMem.icl" //(dl_client_state,[ModuleUnknown (strip_abc_and_o_extension object_file) "" \\ object_file <- object_file_names],library_file_names,state);
		};
		
	#! n_libraries 
		= length library_files;
	#! ((ok,library_list,n_library_symbols,names_table),io)
		= accFiles (ReadLibraryFiles2 library_files (~n_libraries) 0  create_names_table) io;
	| not ok
		#! msg
			= "error reading dynamic libraries";
		= (0,AddMessage (LinkerError msg) dl_client_state,dl_server_state,io);
		
	#! (marked_bool_a,marked_offset_a,_)
		= create_xcoff_boolean_array 0 0 n_libraries n_library_symbols library_list [];
	
	#! state = { state &
			// linker tables	
			n_libraries 		= n_libraries
		,	n_library_symbols 	= n_library_symbols

		,	marked_bool_a 		= marked_bool_a
		,	marked_offset_a 	= marked_offset_a
		,	module_offset_a 	= createArray n_library_symbols 0
		,	namestable			= names_table
		
		// dynamic libraries
		,	library_list 		= library_list
		,	library_file_names	= strip_paths_from_file_names library_files

		}
	
	// macOS; patch QuickDraw global variable
	#! (state,dl_client_state,dl_server_state,io)
		= case (sel_platform True False) of {
			True
				// winOs
				-> (state,dl_client_state,dl_server_state,io);
			False
 /*
				#! unknown_module
					= "Clean:run time system:_qd.o";
				#! (ok,_,state,dl_client_state,dl_server_state,io)
					= load_object unknown_module 0 "" state dl_client_state dl_server_state io;
				| not ok
					-> abort "InitialLink2: internal error; qd not found";

				/*
				** The lazily linked client has received of the global qd-variable. This variable has already
				** been initialized by the client by calling InitGraf in order to receive high-level events. 
				** An application however may only call it once. Because the run-time system also needs this 
				** variable, it should be passed on to the run-time system.
				**
				** The solution chosen here is to adapt the dynamic linker to use the address of qd-variable
				** which has been sent by the client. The following code pathes the linker tables to account
				** for that variable.
				*/
				#! (file_n,symbol_n,state)
					= find_name "qd" state;
					
				// mark qd-symbol
				#! (file_n_offset,state)
					= selacc_marked_offset_a file_n state;

				// MV ...    
				#! (marked_bool_a,state)
					= select_marked_bool_a state;
				#! state
					= { state & marked_bool_a = { marked_bool_a & [file_n_offset + symbol_n] = True }};

				// insert qd's absolute address
				#! (qd_address,state)
					= acc_pd_state (\pd_state=:{qd_address} -> (qd_address,pd_state)) state;
				| F ("qd_address(1): " +++ (hex_int qd_address)) True 
					
				#! state
					= app_module_offset_a (\module_offset_a -> {module_offset_a & [file_n_offset + symbol_n] = qd_address }) state;
				-> (state,dl_client_state,dl_server_state,io);
 */
				-> abort "ObjectToMem.icl" //(state,dl_client_state,dl_server_state,io);
	};
		
	#! (/*ok*/_ ,state,dl_client_state,dl_server_state,io)
		= load_modules2 unknown_modules state dl_client_state dl_server_state io;


/*
	// test
	#! (file_n,symbol_n,state)
		= find_name "qd" state;
	#! (first_symbol_n,state)
		= selacc_marked_offset_a file_n state;
	#! (offset,state)
		= selacc_module_offset_a (first_symbol_n+symbol_n) state;
	#! state
		= F ("offset 1=" +++ toString offset) state;
*/

	#! (ok,state)
		= IsErrorOccured state;
	| not ok
		= (0,{dl_client_state & app_linker_state = state},dl_server_state,io);

/*
ENABLE ME FOR ACCESS VIOLATION
	// macOS; patch QuickDraw global variable
	#! state
		= case (sel_platform True False) of {
			True
				// winOs
				-> state;
			False
				/*
				** The lazily linked client has received of the global qd-variable. This variable has already
				** been initialized by the client by calling InitGraf in order to receive high-level events. 
				** An application however may only call it once. Because the run-time system also needs this 
				** variable, it should be passed on to the run-time system.
				**
				** The solution chosen here is to adapt the dynamic linker to use the address of qd-variable
				** which has been sent by the client. The following code pathes the linker tables to account
				** for that variable.
				*/
				#! (file_n,symbol_n,state)
					= find_name "qd" state;
					
				// mark qd-symbol
				#! (file_n_offset,state)
					= selacc_marked_offset_a file_n state;

				// MV ...    
				#! (marked_bool_a,state)
					= select_marked_bool_a state;
				#! marked_bool_a
					= { marked_bool_a & [file_n_offset + symbol_n] = True };

				// insert qd's absolute address
				#! (qd_address,state)
					= acc_pd_state (\pd_state=:{qd_address} -> (qd_address,pd_state)) state;
				| F ("qd_address(1): " +++ (hex_int qd_address)) True 
					
				// HACK: the following statement should put the absolute address for the qd-symbol in the
				//       module offset array. For some reason it doesn't seem to work. For the time being
				//       we make add_module in SearchObject solve the problem by initialising the array
				//       with qd_address.
				#! state
					= app_module_offset_a (\module_offset_a -> {module_offset_a & [file_n_offset + symbol_n] = qd_address}) state;
							
				-> { state & marked_bool_a = marked_bool_a };
				// .. MV
//				-> state;
	};
*/

	// link these modules using the main symbol
	#! main_symbols
		= [SymbolUnknown  "" main_symbol]; //sel_platform [SymbolUnknown main_symbol ""] [SymbolUnknown main_symbol "",SymbolUnknown "STATE" "", SymbolUnknown "LINKER" ""];
	#! ((wii,[start_addr:_],state,dl_client_state),io)
		= /*accFiles (*/LinkUnknownSymbols /*[SymbolUnknown main_symbol ""]*/ main_symbols state /*)*/ (-1) dl_client_state io;

/*
	// test
	#! (file_n,symbol_n,state)
		= find_name "qd" state;
	#! (first_symbol_n,state)
		= selacc_marked_offset_a file_n state;
	#! (offset,state)
		= selacc_module_offset_a (first_symbol_n+symbol_n) state;
	#! state
		= F ("offset 3=" +++ hex_int offset ) state;
*/

	#! state
		= AddMessage (Verbose ("start_addr (calculated): " +++ (hex_int start_addr))) state;

	#! (ok,state)
		= IsErrorOccured state;
	| not ok
		= (0,{dl_client_state & app_linker_state
		 = state},dl_server_state,io);

	// send start address to client
	#! io
		= SendAddressToClient client_id start_addr io;


//	| ReplyReq start_addr
		= (start_addr,{dl_client_state & app_linker_state = state},dl_server_state,io); //abort "linked"; //(True,start_addr,server_state,state,files);	
//import DebugUtilities;

//LinkUnknownSymbols :: ![.ModuleOrSymbolUnknown] !*State *(IOState *a) -> *(*(!Maybe !WriteImageInfo,.[Int],*State),*IOState *a);
LinkUnknownSymbols :: ![.ModuleOrSymbolUnknown] !*State !Int !*DLClientState *(IOState *a) -> *(*(!Maybe !WriteImageInfo,.[Int],*State,!*DLClientState),*IOState *a);
LinkUnknownSymbols unknown_modules_or_symbols state library_instance_i dl_client_state io
	| True <<- ("LinkUnknownSymbols",unknown_modules_or_symbols)
/*
	// test
	#! (qd_file_n,qd_symbol_n,state)
		= find_name "qd" state;
	| F ("file_n: " +++ toString qd_file_n +++ " - symbol_n:" +++ toString qd_symbol_n) True
*/

	/*
	** unknown_symbols contains those symbols that have not been yet been
	** placed into memory. Only these symbols should be loaded and linked.
	*/
	#! (unknown_symbols,state,io)
		= foldl filter_symbol ([],state,io) unknown_modules_or_symbols;
	#! (base_address,wii,state,dl_client_state,io)
		= link_unknown_symbols unknown_symbols state library_instance_i dl_client_state io;
	#! (ok,state)
		= IsErrorOccured state;
	| not ok
		= abort "error"; //((wii,[],state),io);
		
	/*
	** The address of all unknown symbols, if defined are encoded as a
	** string and returned *in the order* as in the unknown_modules_or_symbols
	** parameter. The conversion function uses the order to identify the
	** proper descriptor.
	*/ 
	#! (_,symbol_addresses,state)
		= foldl compute_symbol_address (base_address,[],state) unknown_modules_or_symbols
	= ((wii,symbol_addresses,state,dl_client_state),io);
where {
	filter_symbol (symbols,state,files) symbol
		#! symbol_name
			= extract_symbol_name symbol;
		| symbol_name == ""
			= (symbols,state,files);
			
			/*
			** A valid symbol_name has been found. It is guaranteed by load_modules
			** that it exists. But it might not be in memory yet.
			*/
			#! (file_n,symbol_n,state)
				= find_name symbol_name state;
			| F ("LinkUnknownSymbols(f): " +++ symbol_name +++ "file_n: " +++ toString file_n +++ " - symbol_n: " +++ toString symbol_n)  True
			#! (symbol_address,state)
				= address_of_label2 file_n symbol_n state;
			| F (symbol_name +++ "! address: " +++ toString symbol_address) symbol_address == 0
				/*
				** The symbol has not been loaded into memory. Insert in the list
				** of symbols to be loaded and linked.
				*/
//				| True <<- ("filter_symbol",symbol_name,file_n,symbol_n)
				= (symbols ++ [(file_n,symbol_n)],state,files);
//				= abort "aaa";
				
				/*
				** The symbol is already present in memory. It can safely be 
				** skipped.
				*/
				= (symbols,state,files);
				
	compute_symbol_address (base_address,symbol_addresses,state) symbol
		#! symbol_name
			= extract_symbol_name symbol;
		| symbol_name == ""
			= (base_address,symbol_addresses,state);
			
			#! (file_n,symbol_n,state)
				= /*F ("LinkUnknownSymbols(g): " +++ symbol_name)*/ find_name symbol_name state;
			#! (symbol_address,state)
				= address_of_label2 file_n symbol_n state;
				
			= (base_address,symbol_addresses ++ [ base_address + symbol_address],state);
			
	extract_symbol_name (ModuleUnknown _ symbol_name)
		= symbol_name;
	extract_symbol_name (SymbolUnknown  _ symbol_name )  //symbol_name _)
		= symbol_name;
	extract_symbol_name _ 
		= abort "extract_symbol_name: no match";
}

/*
** MAC
from ExtLibrary import Toolbox, GetToolBox;
from pointer import LoadByte, StoreByte, Ptr;
*/
// ---------------------------------------------------------------------------------------
/*
selectively_import_symbols_in_xcoff_files main_symbols state=:{n_xcoff_symbols,n_library_symbols}
	#! newly_marked_bool_a
		= createArray (n_xcoff_symbols + n_library_symbols) False;
	#! (newly_marked_bool_a,state)
		= foldSt sel_import main_symbols (newly_marked_bool_a,state);
	= abort (toString (size newly_marked_bool_a));
where {
// import_symbols_in_xcoff_files
// mark_used_modules
	sel_import (SymbolUnknown _ label_name) (newly_marked_bool_a,state)
		#! (file_n,symbol_n,state)
			= find_name label_name state;
		= selective_import_symbol file_n symbol_n (newly_marked_bool_a,state)
}; // selectively_import_symbols_in_xcoff_files
*/
from xcoff import SIZE_OF_RELOCATION;

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 (SectionLabel section_n label_offset) file_n symbol_n state
	#! (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);

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
	#! 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);
//	= (newly_marked_bool_a,state);

where {
	selective_symbol_import2 symbol=:(SectionLabel section_n label_offset) _ _ (newly_marked_bool_a,state)
/* old ...
		#! (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
				};
			= selective_import_symbol file_n section_symbol_n (newly_marked_bool_a,state);
			= abort "unreachable";
... old */
		#! (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);
	where {
		
	
	}

	selective_symbol_import2 (Module c1 length virtual_address c2 n_relocations relocations) _ _ s
		= 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;
				
				
				// // DLClientState
			# (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
	//					-> abort "dmdjk";
						
					/*
					// replaceLabel
						#! (symbol,state) 
		= state!xcoff_a.[file_n].symbol_table.symbols.[symbol_n];
			#! (chosen_module_n_index,dl_client_state)
		= symbol_n_to_offset file_n chosen_module_n dl_client_state;
	#! (chosen_module_n_address,dl_client_state)
		= dl_client_state!app_linker_state.module_offset_a.[chosen_module_n_index];

		
				*/
			
						#! (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);
			
			// import_symbols (pdSymbolTable)
			= abort "imported not found!";
	
	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;
};

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


// ------------------
from utilities import foldSt;

import DLState;

move_names_table_from_library_instance_i_to_state library_instance_i dl_client_state
	// move namestable from library_instance to current state
	#! (names_table,dl_client_state)
		= acc_names_table library_instance_i dl_client_state;

	
	#! (state,dl_client_state)
		= acc_state (\s -> (s,EmptyState)) dl_client_state;
	#! state
		= { state &
			namestable = names_table
		};
	= (state,dl_client_state);
	
move_names_table_from_state_to_library_instance_i library_instance_i state dl_client_state
	#! (names_table,state)
		= select_namestable state;
	#! dl_client_state
		= { dl_client_state &
			app_linker_state = state
		,	cs_library_instances.lis_library_instances.[library_instance_i].li_names_table = names_table
			};		
	= dl_client_state;


//link_unknown_symbols :: ![(.Int,.Int)] *State *(IOState *a) -> *(Int,!WriteImageInfo,*State,*IOState *a);
link_unknown_symbols [] state library_instance_i dl_client_state io
	= (0,Nothing /*default_write_image_info*/,state,dl_client_state,io);		
link_unknown_symbols unknown_symbols state=:{n_xcoff_symbols,n_library_symbols,library_list,n_libraries,n_xcoff_files,one_pass_link} library_instance_i dl_client_state io			
/* OLD ...
	#! (already_marked_bool_a,state)
		= select_marked_bool_a state;
	#! (marked_offset_a,state)
		= select_marked_offset_a state;
//	#! (module_offset_a,state)
//		= select_module_offset_a state;
	#! (xcoff_a,state)
		= select_xcoff_a state;
			
	#! marked_bool_a
		= createArray (n_xcoff_symbols + n_library_symbols) False;
	 	
	#! (marked_offset_a,marked_bool_a,xcoff_a,already_marked_bool_a,ok,state)
		= foldl mark_unknown_symbols (marked_offset_a,marked_bool_a,xcoff_a,already_marked_bool_a,True,state) unknown_symbols;
	| not ok
		/*
		** There are still undefined symbols which should have all been resolved by the load_modules2
		** called before.
		*/
		#! msg
			= "link_unknown_symbols (internal error): no undefined symbols expected";
		= (0,default_write_image_info,AddMessage (LinkerError msg) state,io);
		
	// ...
//	#! (file_n_base,marked_offset_a)
//		= marked_offset_a!file_n
//	#! (marked,marked_bool_a)
//		= marked_bool_a![file_n_base + 151];




	#! (names_table,state)
		= select_namestable state;
	#! (NamesTableElement q symbol_n22 file_n22 _ ,names_table)
		= find_symbol_in_symbol_table "e__StdDynamic__eabuild__block" names_table;
	#! s
		= "  <" +++ q +++ ">" +++ "file_n: " +++ toString file_n22 +++ " symbol_n: "  +++ toString symbol_n22;
	#! state
		= /*F s*/ {state & namestable = names_table};
	
	// find_symbol_in_symbol_table :: !String !NamesTable -> (!NamesTableElement,!NamesTable);

	// ...
		
		
	#! state
		= { state &
		// linker tables
			marked_bool_a		= marked_bool_a
		,	marked_offset_a		= marked_offset_a
		,	xcoff_a 			= xcoff_a
		};
/*		
	// test
	#! (qd_address,state)
		= acc_pd_state (\pd_state=:{qd_address} -> (qd_address,pd_state)) state;
	| F ("qd_address(2): " +++ (hex_int qd_address)) True 
*/

*/
	// new...
	#! newly_marked_bool_a
		= createArray (n_xcoff_symbols + n_library_symbols) False;
	#! (newly_marked_bool_a,state)
		= foldSt (\(file_n,symbol_n) s -> selective_import_symbol file_n symbol_n s) unknown_symbols (newly_marked_bool_a,state);
		
/*
	#! (already_marked_bool_a,state)
		= select_marked_bool_a state;
	#! state
		= { state &
			marked_bool_a	= newly_marked_bool_a
		};
*/


	// ensure that all needed prefixes are linked ...
	#! (newly_marked_bool_a,state,dl_client_state)
		= case (library_instance_i < 0) of {
			True
				// a hack to load in the conversion functions which are
				// added to names table of the main library instance.
				-> (newly_marked_bool_a,state,dl_client_state);
			False
			/*
				#! (names_table,state)
					= select_namestable state;
				#! dl_client_state
					= { dl_client_state &
						app_linker_state = state
					,	cs_library_instances.lis_library_instances.[library_instance_i].li_names_table = names_table
						};		
			*/
				#! dl_client_state
					= move_names_table_from_state_to_library_instance_i library_instance_i state dl_client_state;
					
				#! (l,(newly_marked_bool_a,dl_client_state))
					= loop_on_types library_instance_i (newly_marked_bool_a,dl_client_state);
			
			
				#! (state,dl_client_state)
					= move_names_table_from_library_instance_i_to_state library_instance_i dl_client_state;

			/*
				// move namestable from library_instance to current state
				#! (names_table,dl_client_state)
					= acc_names_table library_instance_i dl_client_state;
			
				
				#! (state,dl_client_state)
					= acc_state (\s -> (s,EmptyState)) dl_client_state;
				#! state
					= { state &
						namestable = names_table
					};
			*/
				-> (newly_marked_bool_a,state,dl_client_state);
					
					
					/*
				#! (newly_marked_bool_a,state)
					= select_marked_bool_a state;
				#! state
					= { state &
						marked_bool_a	= already_marked_bool_a
					};
				#! (newly_marked_bool_a,state)
					= foldSt (\(file_n,symbol_n) s -> selective_import_symbol file_n symbol_n s) l (newly_marked_bool_a,state);
			
				#! (already_marked_bool_a,state)
					= select_marked_bool_a state;
				#! state
					= { state &
						marked_bool_a	= newly_marked_bool_a
					};
				-> (already_marked_bool_a,state,dl_client_state);
				*/
		};
		
	#! (already_marked_bool_a,state)
		= select_marked_bool_a state;
	#! state
		= { state &
			marked_bool_a	= newly_marked_bool_a
		};




	
	// acc_state ::  (!*State -> (!.x,!*State)) !*DLClientState -> !(!.x,*DLClientState);
//	| True <<- ("needed prefixes",l)
		
	// ... ensure that all needed prefixes are linked

	// ...new

		
	#! (base_address,wii,state,io)
		= write_image state io;

/*		
	// TEST
	#! (file_n,symbol_n,state)
		= find_name "qd" state;
		
	// mark qd-symbol
	#! (file_n_offset,state)
		= selacc_marked_offset_a file_n state;
	
	#! (dest_qd_address,state)
		= selacc_module_offset_a (file_n_offset + symbol_n) state;
		
		
	#! (toolbox,io)
		= GetToolBox io;
	#! toolbox
		= copy_mem qd_address 206 dest_qd_address toolbox;
		
	#! io
		= PutToolBox toolbox io;
*/		
	
/*
	// test
	#! (qd_address,state)
		= acc_pd_state (\pd_state=:{qd_address} -> (qd_address,pd_state)) state;
	#! state
		= F ("qd_address(3): " +++ (hex_int qd_address)) state;
*/

	// merge previous and new marked symbols
	#! (marked_bool_a,state)
		= select_marked_bool_a state;	
	#! all_marked_bool_a
		= or_bool_arrays marked_bool_a already_marked_bool_a;	
	= (base_address,Just wii,{state & marked_bool_a = all_marked_bool_a},dl_client_state,io);


/*
// pc 
	# xcoff_list = xcoff_array_to_list 0 xcoff_a;

	// TEXT, calculating text size
	#! (marked_bool_a,text_end_vaddr0,module_offset_a, xcoff_list)
		= compute_module_offsets Text 0 xcoff_list 0  0 marked_bool_a module_offset_a;
	
	#! (marked_bool_a,_,n_imported_symbols)
		= compute_idata_strings_size library_list 0 0 n_xcoff_symbols marked_bool_a;

	# text_end_vaddr = text_end_vaddr0+4 * n_imported_symbols;

	// DATA, calculating data size		
	# (marked_bool_a,data_end_vaddr,module_offset_a, xcoff_list)
		= compute_module_offsets Data 0 xcoff_list 0 0 marked_bool_a module_offset_a;

	bss_vaddr = (data_end_vaddr+4095) bitand (-4096);

	#! (marked_bool_a,bss_end_vaddr,module_offset_a, xcoff_list)
		= compute_module_offsets Bss 0 xcoff_list bss_vaddr 0 marked_bool_a module_offset_a;

	#! (ok,code_p,data_p) 
		= ReceiveCodeDataAdr text_end_vaddr bss_end_vaddr;
	| not ok
		= abort "killed"; 
	
	#! (udata_p,data_p)
		= MakeNonUnique data_p;
			
	#! (ucode_p,code_p)
		= MakeNonUnique code_p;
		
	// verbose
	#! messages
		= [
			Verbose ("code from " +++ (hex_int code_p) +++ " to " +++ (hex_int (dec code_p+text_end_vaddr)) +++ " - " +++ toString (dec text_end_vaddr) +++ " bytes")
		,	Verbose ("data from " +++ (hex_int data_p) +++ " to " +++ (hex_int (dec data_p+bss_end_vaddr)) +++ " - " +++ toString (dec bss_end_vaddr) +++ " bytes")
		];
	#! state
		= SetLinkerMessages messages state;

	// Rebase text segment	
	#! (marked_bool_a,_,module_offset_a, xcoff_list)
		= compute_module_offsets Text code_p xcoff_list 0 0 marked_bool_a module_offset_a;
		
	#! (library_list,state) 
		= NeedBaseLibraries library_list n_libraries state;
	#! (ok,state)
		= IsErrorOccured state;
	| not ok
		= (state,files);

		
	#! (marked_bool_a,library_list,_,module_offset_a) 
		= Dcompute_imported_library_symbol_offsets library_list (code_p+text_end_vaddr0) (~n_libraries) n_xcoff_symbols marked_bool_a module_offset_a;
	
	// ----
	// DATA
	#! (marked_bool_a,_,module_offset_a, xcoff_list)
		= compute_module_offsets Data data_p xcoff_list 0 0 marked_bool_a module_offset_a;

	#! (marked_bool_a,_,module_offset_a, xcoff_list)
		= compute_module_offsets Bss data_p xcoff_list bss_vaddr 0 marked_bool_a module_offset_a;

	#! state = { state &
		// Nieuw:
		n_libraries = n_libraries,
		n_xcoff_symbols = n_xcoff_symbols,
		n_library_symbols = n_library_symbols,
		library_list = library_list,
		//namestable = names_table,
	
		// Oud:
		n_xcoff_files = n_xcoff_files,
		marked_bool_a = marked_bool_a,
		marked_offset_a = marked_offset_a,
		module_offset_a = module_offset_a,
		xcoff_a = xcoff_list_to_xcoff_array xcoff_list n_xcoff_files,
		one_pass_link = one_pass_link
 	 };
	
	#! (_,_,state,files)
		= write_code_to_pe_files n_xcoff_files True 0 0 (0,0) state one_pass_link ucode_p files;
	
/*	
	#! (marked_bool_a,state)
		= select_marked_bool_a state;	
	#! all_marked_bool_a
		= or_bool_arrays marked_bool_a already_marked_bool_a;
		
	= ({state & marked_bool_a = all_marked_bool_a},files);
*/
*/
	where {	
/*
		copy_mem qd_address i dest_qd_address toolbox
			| i == 0
				= toolbox;
				
				#! (v,toolbox)
					= LoadByte qd_address toolbox;
				#! toolbox
					= StoreByte dest_qd_address v toolbox;
				= copy_mem (inc qd_address) (dec i) (dec dest_qd_address) toolbox;
*/
	
		mark_unknown_symbols s=:(marked_offset_a,marked_bool_a,xcoff_a,already_marked_bool_a,False,state) (file_n,symbol_n)
			= s;
						
		mark_unknown_symbols (marked_offset_a,marked_bool_a,xcoff_a,already_marked_bool_a,ok,state) (file_n,symbol_n)

		// find_name3 :: .Int .Int !*State -> *(.Bool,{#Char},*State);
			#! (found,ms,state)
				= find_name3 file_n symbol_n state;
//			#! xcoff_a
//				= F ("mark root: " +++ (if found ms "<unnamed>")) xcoff_a;

/*
			// NEW ...
			#! (names_table,state)
				= select_namestable state;
			#! (NamesTableElement q symbol_n22 file_n22 _ ,names_table)
				= find_symbol_in_symbol_table "e__StdDynamic__eabuild__block" names_table;
			#! s
				= "  <" +++ q +++ ">" +++ "file_n: " +++ toString file_n22 +++ " symbol_n: "  +++ toString symbol_n22;
			#! state
				= F s {state & namestable = names_table};
			// ... NEW
*/
			
			#! (s=:(undefined_symbols,marked_offset_a,marked_bool_a,xcoff_a))
				= mark_used_modules symbol_n file_n [] already_marked_bool_a marked_bool_a marked_offset_a xcoff_a;
			| not (isEmpty undefined_symbols)
				= (marked_offset_a,marked_bool_a,xcoff_a,already_marked_bool_a,False,state); 
			= (marked_offset_a,marked_bool_a,xcoff_a,already_marked_bool_a,ok,state);
}


or_bool_arrays marked_bool_a2 marked_bool_a = { b1 || b2 \\ b1<-:marked_bool_a2 & b2<-:marked_bool_a };
	
ReadLibraryFiles2 :: ![String] !Int !Int !NamesTable !*Files -> ((!Bool,!LibraryList,!Int,!NamesTable),!*Files);
ReadLibraryFiles2 l library_n n_library_symbols0 names_table0 files0
	#! (b,l,i,f,n)
		= ReadLibraryFiles l library_n n_library_symbols0 files0 names_table0;
	= ((b,l,i,n),f);
	
	ReadLibraryFiles :: ![String] !Int !Int !*Files !NamesTable -> (!Bool,!LibraryList,!Int,!*Files,!NamesTable);
	ReadLibraryFiles [] library_n n_library_symbols0 files0 names_table0
		= (True,EmptyLibraryList,n_library_symbols0,files0,names_table0);
	ReadLibraryFiles [file_name:file_names] library_n n_library_symbols0 files0 names_table0
		#! (ok1,library_name,library_symbols,n_library_symbols,files1,names_table1)
			= read_library_file file_name library_n files0 names_table0;
		
		| ok1
			#! (ok10,libraries,n_library_symbols1,files2,names_table2)
				= ReadLibraryFiles file_names (inc library_n) (n_library_symbols0+n_library_symbols) files1 names_table1;		
			= (ok10,Library library_name /* mac */ 0 library_symbols n_library_symbols libraries,n_library_symbols1,files2,names_table2);
			
			= abort ("ReadLibraryFiles2: could not read '" +++ file_name +++ "'");
			
/*	
New version of SearchObject guarantees that this is the case		
			/*
			** The *_library-file could not be found, ask user
			*/
			#! (_,library_file)
				= ExtractPathAndFile file_name
			#! (cancelled,library_path)
				= GetPathOfFile ("Please select library '" +++ library_file +++ "'") ""
			| cancelled
				= (False,EmptyLibraryList,n_library_symbols0,files1,names_table1);
				= ReadLibraryFiles [library_path:file_names] library_n n_library_symbols0 files1 names_table1;
*/
		{}{
			
			
		}
		
/*
	/*
	** The base of each library is calculated again and again. Clearly this can
	** be optimized but then also the AddAndInit must also be adopted because 
	** the bases need to be filled in the library list. 
	*/
	
	NeedBaseLibraries :: !LibraryList !Int !*State -> (!LibraryList,!*State);
	NeedBaseLibraries libraries n_libraries state
		#! library_names 
			= need_libraries libraries ""; 
		#! (ok,library_addresses)
			= need_base_libraries library_names n_libraries;
		| not ok
			#! msg
				= "NeedBaseLibraries: one of the required dynamic libraries cannot be found (needs improvement)";
			= (libraries,AddMessage (LinkerError msg) state);
		
		
			//= abort "NeedBaseLibraries";
		= (store_base_addresses library_addresses 0 libraries,state);
	where
	{
		need_libraries :: !LibraryList !String  -> !String;
		need_libraries EmptyLibraryList libraries
			= libraries +++ "\0";
		need_libraries (Library library_name _ _ _ librarylists) libraries
		    | library_name == "" 
		    	= abort "need_libraries:  library without name";
				= need_libraries librarylists (libraries +++ library_name +++ "\0");
			
		need_base_libraries :: !String !Int -> (!Bool,!String);
		need_base_libraries _ _
			= code {
				ccall NeedBaseLibraries "SI-IS"
			};
			
		store_base_addresses :: !String !Int !LibraryList -> !LibraryList;
		store_base_addresses _ _ EmptyLibraryList
			= EmptyLibraryList;
		store_base_addresses library_addresses ith_address (Library library_name library_base_address library_symbols_list n_library_symbols library_list)
			#! library_base_address
				= library_addresses ILONG ith_address;
			#! new_libraries
				= store_base_addresses library_addresses (ith_address+4) library_list
			= Library library_name library_base_address library_symbols_list n_library_symbols new_libraries;
	};

*/

import  CollectTypes; // import collect_types, CollectTypesState, default_collect_types_state; 
from utilities import mapSt, second_of_2_tuple;

// It is assumed that a library instance is only loaded once which implies that if the library instance implements some
// type, then all its labels implementing that type must have been linked. The initial marking just marks the symbols
// reachable from set of root symbols. In general label prefixes may not refer to eachother, so they have to be marked
// explicitly. This function carries out this task.
loop_on_types library_instance_i (newly_marked_bool_a,dl_client_state=:{cs_main_library_instance_i})
	// general
	#! (type_table_i,dl_client_state)
		= dl_client_state!cs_library_instances.lis_library_instances.[library_instance_i].li_type_table_i;
	#! (tt_n_tio_common_defs,dl_client_state)
		= dl_client_state!cs_type_tables.[type_table_i].tt_n_tio_common_defs;

	#! (labels,newly_marked_bool_a,dl_client_state)
		= loopAst (loop_on_module type_table_i) ([],newly_marked_bool_a,dl_client_state) tt_n_tio_common_defs;

	= (labels,(newly_marked_bool_a,dl_client_state));
where {
	loop_on_module type_table_i tio_tr_module_n (labels,newly_marked_bool_a,dl_client_state)
		// loop on type definitions
		# (tio_com_type_defs,dl_client_state)
			= dl_client_state!cs_type_tables.[type_table_i].tt_tio_common_defs.[tio_tr_module_n].tio_com_type_defs;
		# (labels,newly_marked_bool_a,dl_client_state)
			= mapAiSt loop_on_type_def tio_com_type_defs (labels,newly_marked_bool_a,dl_client_state);
		= (labels,newly_marked_bool_a,dl_client_state);
	where {
		// Determine which label prefixes have not yet been linked in. 
		loop_on_type_def tio_tr_type_def_n {tio_td_name} (labels,newly_marked_bool_a,dl_client_state)
			# tio_type_reference
				= { default_elem &
					tio_tr_module_n		= tio_tr_module_n
				,	tio_tr_type_def_n	= tio_tr_type_def_n
				};
			# type
				= LIT_TypeReference library_instance_i tio_type_reference;

			#! (li_type_table_i,dl_client_state)
				= dl_client_state!cs_library_instances.lis_library_instances.[library_instance_i].li_type_table_i;
			#! (type_name,labels_implementing_type,dl_client_state)
				= get_type_label_names tio_type_reference li_type_table_i dl_client_state;

			#! (any_label_implemented,unlinked_labels,newly_marked_bool_a,dl_client_state)
				= foldSt any_label_implemented labels_implementing_type (False,[],newly_marked_bool_a,dl_client_state);
			| any_label_implemented && not (isEmpty unlinked_labels)
				// at least one label but not all labels have been implemented for the type. The other should be marked
				// too. If partially linked type are supported in the future, then this code is no longer necessary.
				# dl_client_state
					= dl_client_state <<- ("to link: ",type_name,unlinked_labels)
					
				// reachable types ... types dependent on the current type are *not* reachable from the type.
				# (type_tables,dl_client_state)
					= get_type_tables dl_client_state;
				# type
					= (TypeTableTypeReference li_type_table_i tio_type_reference);
				# (cts=:{cts_type_dependencies,cts_type_tables=type_tables})
					= collect_types type type {default_collect_types_state & cts_type_tables = type_tables};
				
					
				// convert to names
				// print_type_table_reference :: !Int !TIO_TypeReference !{#*TypeTable} -> (!String,{#*TypeTable});
				# (cts_type_dependencies2,type_tables)
					= mapSt (\(tio_type_reference,_) type_tables -> print_type_table_reference li_type_table_i tio_type_reference type_tables) cts_type_dependencies type_tables;
					
				# dl_client_state
					= { dl_client_state &
						cs_type_tables = type_tables
					};	
				# dl_client_state
					= dl_client_state <<- ("dep types",cts_type_dependencies2)
				# (unlinked_but_reachable_labels_of_types,newly_marked_bool_a,dl_client_state)
					= foldSt detect_unlinked_but_reachable_labels_of_types cts_type_dependencies (unlinked_labels,newly_marked_bool_a,dl_client_state);
				# unlinked_labels
					= unlinked_but_reachable_labels_of_types;
				// ... reachable types

					
				#! (state,dl_client_state)
					= move_names_table_from_library_instance_i_to_state library_instance_i dl_client_state;
				#! (newly_marked_bool_a,state)
					= foldSt (\(_,(file_n,symbol_n)) s -> selective_import_symbol file_n symbol_n s) unlinked_labels (newly_marked_bool_a,state);
				#! dl_client_state
					= move_names_table_from_state_to_library_instance_i library_instance_i state dl_client_state;

				= (labels,newly_marked_bool_a,dl_client_state);
	
			= (labels,newly_marked_bool_a,dl_client_state);
// huidige library instance bevat al een gedeeltelijk implementation van het type				
		where {
			detect_unlinked_but_reachable_labels_of_types ({tio_type_without_definition=Just _},_) (unlinked_but_reachable_labels_of_types,newly_marked_bool_a,dl_client_state)
				// a type without definition is assumed to be linked
				= (unlinked_but_reachable_labels_of_types,newly_marked_bool_a,dl_client_state);

			detect_unlinked_but_reachable_labels_of_types (tio_type_reference,_) (unlinked_but_reachable_labels_of_types,newly_marked_bool_a,dl_client_state)
				# type
					= LIT_TypeReference library_instance_i tio_type_reference;
	
				#! (li_type_table_i,dl_client_state)
					= dl_client_state!cs_library_instances.lis_library_instances.[library_instance_i].li_type_table_i;
				#! (type_name,labels_implementing_type,dl_client_state)
					= get_type_label_names tio_type_reference li_type_table_i dl_client_state;
	
				#! (any_label_implemented,unlinked_labels,newly_marked_bool_a,dl_client_state)
					= foldSt any_label_implemented labels_implementing_type (False,[],newly_marked_bool_a,dl_client_state);
				| any_label_implemented
					= (unlinked_but_reachable_labels_of_types,newly_marked_bool_a,dl_client_state);
					


				#! dl_client_state 
					= dl_client_state <<- ("detect_unlinked_but_reachable_labels_of_types",unlinked_labels);
				#! unlinked_but_reachable_labels_of_types
					= unlinked_labels ++ unlinked_but_reachable_labels_of_types;
				= (unlinked_but_reachable_labels_of_types,newly_marked_bool_a,dl_client_state);
				
		
		
			any_label_implemented label_name (any_label_implemented,unimplemented_labels,newly_marked_bool,dl_client_state)
				# (maybe_file_n_symbol_n,dl_client_state)
					= findLabel label_name library_instance_i dl_client_state;
				| isNothing maybe_file_n_symbol_n
					# dl_client_state
						= dl_client_state <<- ("any_label_implemented; internal error; label '" +++ label_name +++ "' should be in namestable");
					// for the time being do as if the label were implemented
					= (True,unimplemented_labels,newly_marked_bool,dl_client_state)
			
				# (file_n_symbol_n=:(file_n,symbol_n))
					= fromJust maybe_file_n_symbol_n;
				# (symbol_index,dl_client_state)
					= symbol_n_to_offset file_n symbol_n dl_client_state;

				#! (first_symbol_n,dl_client_state)
					= dl_client_state!app_linker_state.marked_offset_a.[file_n];
				#! (is_marked_label,newly_marked_bool)
					= newly_marked_bool![first_symbol_n+symbol_n];
				| is_marked_label
					= (True,unimplemented_labels,newly_marked_bool,dl_client_state);
					
					= (any_label_implemented,[(label_name,file_n_symbol_n):unimplemented_labels],newly_marked_bool,dl_client_state);
		} // loop_on_type_def
	}
};
