implementation module Linker;

// FIXME: remove this dependency
from StdDynamicTypes import FILE_IDENTIFICATION, IS_NORMAL_FILE_IDENTIFICATION, COMPILE_FOR_COT_SUPPORT;
//import DynID;
from DynIDMacros import CREATE_ENCODED_LIBRARY_FILE_NAME, CONVERT_ENCODED_LIBRARY_IDENTIFICATION_INTO_RUN_TIME_LIBRARY_IDENTIFICATION,
						ADD_CODE_LIBRARY_EXTENSION, ADD_TYPE_LIBRARY_EXTENSION;
/*
FILE_IDENTIFICATION md5 normal :== md5;

IS_NORMAL_FILE_IDENTIFICATION :== FILE_IDENTIFICATION False True;

NAME_PREFIXES yes no :== no;

CREATE_ENCODED_LIBRARY_FILE_NAME library_name code_md5 type_md5
	:== (NAME_PREFIXES (library_name +++ "_") "") +++ code_md5 +++ "_" +++ type_md5;
	
CONVERT_ENCODED_LIBRARY_IDENTIFICATION_INTO_RUN_TIME_LIBRARY_IDENTIFICATION base_directory encoded_library_identification
	:== base_directory +++ "\\" +++ DS_LIBRARIES_DIR +++ "\\" +++ encoded_library_identification;

ADD_CODE_LIBRARY_EXTENSION library_identification
	:== library_identification +++ "." +++ EXTENSION_CODE_LIBRARY;
ADD_TYPE_LIBRARY_EXTENSION library_identification
	:== library_identification +++ "." +++ EXTENSION_TYPE_LIBRARY;
*/

import StdFile,StdArray,StdClass,StdEnum,StdInt,StdBool,StdChar;
from StdMisc import abort;
from StdList import ++;
import StdEnv;
from ReadObject import class ExtFileSystem, instance ExtFileSystem Files, read_xcoff_files,read_library_files,read_library_files_new,read_library_files2; // only for PC,read_static_lib_files;
from lib import ::ImportLibrary(..);
from piObjectToDisk import write_object_to_disk;
import SymbolTable;
import ObjectToDisk;
import ExtString, ExtFile;
import LinkerMessages;
import LibraryDynamics;
import State;
import PlatformLinkOptions;
import directory_structure;
import md5;
import Directory;
import StdMaybe;
import Redirections;
import NamesTable;
import pdSymbolTable;
import link32or64bits;
import RWSDebugChoice;

// windows ...
from lib import read_static_lib_files, read_static_lib_files_new, ::ReadStaticLibState(..), default_rsl_state, ::ImportLibrary;

import link_switches;

append_library_lists EmptyLibraryList library_list
	= library_list;
append_library_lists (Library s i1 lsl i2 xs) library_list
	= (Library s i1 lsl i2 (append_library_lists xs library_list));


select_import_libraries :: !*ReadStaticLibState -> *([ImportLibrary],*ReadStaticLibState);
select_import_libraries rsl_state=:{import_libraries}
	= (import_libraries,{rsl_state & import_libraries = []});

link_xcoff_files :: !String !Bool ![String] ![String] ![String] !String !PlatformLinkOptions !Files  -> (!*State,!Files);
link_xcoff_files dynamics_path normal_static_link file_names library_file_names static_libraries application_file_name platform_link_options files 
	// platform independent options
	#! one_pass_link = True;
	/* WARNING:
		The MAC only supports one pass linking. Thus the one_pass_link *must* be set to
		True. The PC simply ignores the flag.
	*/ 	
	#! allow_unused_undefined_symbols = ALLOW_UNUSED_DEFINED_SYMBOLS; //True;
	
	// read object files
	#! (any_extra_sections,read_xcoff_files_errors,sections,n_xcoff_files,xcoff_list,names_table,files,_)
		= read_xcoff_files False file_names create_names_table one_pass_link files 0 default_redirection_state;
	| not (isEmpty read_xcoff_files_errors)
		# linker_messages_state = setLinkerMessages [LinkerError e \\ e <- read_xcoff_files_errors] DefaultLinkerMessages;
		= ({ EmptyState & linker_messages_state = linker_messages_state },files);
	# platform_link_options = plo_set_sections sections platform_link_options;
	# platform_link_options = plo_any_extra_sections any_extra_sections platform_link_options;
	// read static libraries
	# (errors,xcoff_list,names_table,n_xcoff_files,files,lib_library_list,n_library_symbols,n_total_libraries)
		= case (sel_platform True False) of { 
			True
				// winos
				#! (errors,xcoff_list, _, names_table, n_xcoff_files, files,rsl_state,_)
					= read_static_lib_files static_libraries [] names_table n_xcoff_files xcoff_list files default_rsl_state default_redirection_state;

				# (import_libraries,rsl_state) = select_import_libraries rsl_state;
				# n_import_libraries = length import_libraries;
				#! n_libraries = n_import_libraries + length library_file_names;
				#! import_libraries = [[ il_name:il_symbols] \\ {il_name,il_symbols} <- import_libraries ];

				#! (library_list,n_library_symbols,names_table)
					= read_library_files2 import_libraries (~n_libraries) 0 names_table;

				-> (errors,xcoff_list,names_table,n_xcoff_files,files,library_list,n_library_symbols,n_libraries);			
			False
				#! n_libraries = length library_file_names;
				-> ([],xcoff_list,names_table,n_xcoff_files,files,EmptyLibraryList,0,n_libraries);
		};
	| not (isEmpty errors)
		# linker_messages_state = setLinkerMessages [LinkerError e \\ e <- errors] DefaultLinkerMessages;
		= ({ EmptyState & linker_messages_state = linker_messages_state },files);

	// read dynamic libraries	
	#! n_libraries = length library_file_names;
//		n_library_symbols = 0;
	   (read_library_errors,library_list,n_library_symbols,files,names_table)
		= read_library_files library_file_names (~n_libraries) /* old 0 */ n_library_symbols files names_table;
	| not (isEmpty read_library_errors)
		# linker_messages_state = setLinkerMessages [LinkerError e \\ e <- read_library_errors] DefaultLinkerMessages;
		= ({ EmptyState & linker_messages_state = linker_messages_state },files);
	
	# n_libraries = n_total_libraries;
	# library_list = append_library_lists lib_library_list library_list;		
	# (base_va,platform_link_options) = plo_get_base_va platform_link_options;
	# linker_state_info = { one_pass_link = one_pass_link, normal_static_link = normal_static_link,
							linker_state_base_va = base_va};
	#! state
		= { EmptyState &
			linker_state_info = linker_state_info
		,	application_name		= application_file_name
		,	n_libraries				= n_libraries
		,	n_xcoff_files			= n_xcoff_files
		,	n_library_symbols		= n_library_symbols

		,	namestable				= names_table
			
		,	library_list			= library_list
		,	library_file_names		= library_file_names
		};
		
	#! (state,platform_link_options,files) 
		= (ALLOW_UNUSED_UNDEFINED_SYMBOLS resolve_symbol_references_lazily try_to_resolve_references_immediately) 
		xcoff_list state platform_link_options files;
	#! (ok,state) = IsErrorOccured state;
	| not ok
		= (state,files);

/* !!
		
	// resolve symbolic references by name
	#! (undefined_symbols,xcoff_list,names_table)
		= import_symbols_in_xcoff_files xcoff_list 0 [] names_table;
	| not (isEmpty undefined_symbols) && not allow_unused_undefined_symbols
		<<- ("%%%",undefined_symbols,allow_unused_undefined_symbols)
		# linker_messages_state
			= setLinkerMessages [LinkerError ("undefined symbol: " +++ symbol_name) \\ (symbol_name,_,_)<-undefined_symbols] DefaultLinkerMessages;
		= ({ EmptyState & linker_messages_state = linker_messages_state },files);
		
	// check for the existence of main entry and any exported symbols
	# (main_entry_found,main_file_n,main_symbol_n,			// main entry
	   all_exported_symbols_found,entry_datas,				// exported symbols (found,symbol_name,file_n,symbol_n)
	   names_table,											// names table
	   platform_link_options)
	   	= find_root_symbols names_table platform_link_options;
	| not main_entry_found || not all_exported_symbols_found
		# undefined_main_entry
			= case main_entry_found of {
				True
					-> [];
				False
					-> ["Symbol \"main\" is not defined"];
			};
		# undefined_exported_entries
			= case all_exported_symbols_found of {
				True
					-> [];
				False 
					-> [ ("Exported symbol \"" +++ name +++ "\" is not defined.") \\ (found,name,file_n,symbol_n) <- entry_datas | not found ];
			};
		# linker_messages_state
			= setLinkerMessages [LinkerError e \\ e <- (undefined_main_entry ++ undefined_exported_entries)] DefaultLinkerMessages;
		= ({ EmptyState & linker_messages_state = linker_messages_state },files);

	# platform_link_options
		= plo_set_main_file_n_and_symbol_n main_file_n main_symbol_n platform_link_options

	// mark only used symbols
	# root_entries
		= [(True,"",main_file_n,main_symbol_n) : entry_datas];
	#! (unused_undefined_symbols,n_xcoff_symbols,marked_bool_a,marked_offset_a,xcoff_a,names_table)
		= mark_modules_list [] xcoff_list n_xcoff_files n_libraries n_library_symbols library_list root_entries names_table;
	| False //not (isEmpty undefined_symbols)
		# linker_messages_state
			= setLinkerMessages [LinkerError ("unused undefined symbol " +++ e) \\ e <- unused_undefined_symbols] DefaultLinkerMessages;
		= ({ EmptyState & linker_messages_state = linker_messages_state },files);
	
	# linker_messages_state
		= setLinkerMessages [LinkerWarning ("unused undefined symbol " +++ e) \\ e <- unused_undefined_symbols] DefaultLinkerMessages;
		
/*
// PC; should be built-in
	// remove garbage from symbol table (only for static linker)
	#! (marked_bool_a,xcoff_a) 
		= case normal_static_link of {
			True
				-> remove_garbage_from_symbol_table 0 n_xcoff_files 0 marked_bool_a xcoff_a;
			False
				-> (marked_bool_a,xcoff_a);
		};
*/

/*
// MAC; Xcoff-executable should be built-in
	# (sections,platform_link_options)
		= plo_get_sections platform_link_options;
	# (ok,pef_application_size,files)
		= case /*generate_xcoff*/ False of { 
			False
				-> write_pef_file application_file_name n_xcoff_files n_libraries n_library_symbols library_list 
						main_symbol_n main_file_n one_pass_link sections 
						n_xcoff_symbols marked_bool_a marked_offset_a xcoff_a files;				
/*
uniek maken
			True
				-> write_xcoff_file application_file_name n_xcoff_files n_libraries n_library_symbols library_list 
						main_symbol_n main_file_n one_pass_link sections 
						n_xcoff_symbols marked_bool_a marked_offset_a xcoff_a files;
						//abort "link_xcoff_files: a xcoff executable not supported";
*/
		};
*/
	// create state
	#! state 
		= { EmptyState &
			// misc
				one_pass_link			= one_pass_link
			,	normal_static_link		= normal_static_link
			
			// linker tables
			,	application_name		= application_file_name
			,	n_libraries				= n_libraries
			,	n_xcoff_files 			= n_xcoff_files
			,	n_xcoff_symbols			= n_xcoff_symbols
			,	n_library_symbols		= n_library_symbols
			
			,	marked_bool_a			= marked_bool_a
			,	marked_offset_a			= marked_offset_a
			,	xcoff_a 				= xcoff_a
			,	namestable				= names_table
		
			// dynamic libraries
			,	library_list 			= library_list
			,	library_file_names		= if normal_static_link [] (strip_paths_from_file_names library_file_names)
		};
!! */

	#! (state,platform_link_options,files)
		= case linker_state_info.normal_static_link of { //(normal_static_link || (not normal_static_link && not dynamics)) of {
			True			
				#! (state,platform_link_options,files)
					= write_object_to_disk platform_link_options state files;
						 
				// check for link errors during generation	
				#! (ok,state)
					= IsErrorOccured state;

				#! (_,_,state,platform_link_options,files)
					= case ok of {
						True
							-> post_process state platform_link_options files;
						False
							-> (False,[],state,platform_link_options,files);
					};
				-> (state,platform_link_options,files);
			False
				| IS_NORMAL_FILE_IDENTIFICATION
					#! (written, library_path_name,state,files)
						= write_batch_file application_file_name application_file_name dynamics_path state files;
					| not written
						-> (state,platform_link_options,files);
					// plo_set_console_window
					-> build_type_and_code_library file_names library_file_names static_libraries library_path_name state platform_link_options files;
					
					| COMPILE_FOR_COT_SUPPORT
						#! (state,platform_link_options,files)
							= write_cots application_file_name dynamics_path state file_names library_file_names static_libraries platform_link_options files;
						-> (state,platform_link_options,files);
					
					#! (r,state,platform_link_options,files)
						= write_code_and_type_library application_file_name dynamics_path state file_names library_file_names static_libraries platform_link_options files;
					| isNothing r
						-> (state,platform_link_options,files);
						
					#! (library_file_name,temp_code_p,temp_type_p)
						= fromJust r;
			
					#! (_,files)
						= fremove temp_code_p files;
					#! (_,files)
						= fremove temp_type_p files;

					#! (written,library_path_name,state,files)
						= write_batch_file application_file_name library_file_name dynamics_path state files;
					| not written
						-> (state,platform_link_options,files);

					-> (state,platform_link_options,files);
		};
	= (state,files);

EXTRACT_FILE_NAME file_name
	:== (snd (ExtractPathAndFile (fst (ExtractPathFileAndExtension file_name))));
		
write_code_and_type_library application_file_name dynamics_path state file_names library_file_names static_libraries platform_link_options files
		#! (dynamic_linker_path,_)
			= ExtractPathAndFile dynamics_path;
		# (_,files)
			= ds_create_directory DS_LIBRARIES_DIR dynamic_linker_path files;

		// get root of dynamic linker
		#! encoded_library_identification
			= (CREATE_ENCODED_LIBRARY_FILE_NAME "temp" "code" "type");
		#! rt_library_identification
			= CONVERT_ENCODED_LIBRARY_IDENTIFICATION_INTO_RUN_TIME_LIBRARY_IDENTIFICATION dynamic_linker_path encoded_library_identification;
			
		#! temp_code_path
			= ADD_CODE_LIBRARY_EXTENSION rt_library_identification;
		#! ((ok1,temp_code_p),files)
			= pd_StringToPath temp_code_path files;
			
		#! temp_type_path
			= ADD_TYPE_LIBRARY_EXTENSION rt_library_identification;
		#! ((ok2,temp_type_p),files)
			= pd_StringToPath temp_type_path files;
		| not ok1 || not ok2
			#! msg
				= "cannot convert '" +++ (if (not ok1) temp_code_path temp_type_path) +++ "'";
			#! state
				= AddMessage (LinkerError msg) state;
			= (Nothing,state,platform_link_options,files);
			
		// create libraries with temporary names
		#! (state,platform_link_options,files)
			= build_type_and_code_library file_names library_file_names static_libraries rt_library_identification state platform_link_options files;
			
		// rename code library
		#! (code_lib_md5,files)
			= getMd5DigestFromFile temp_code_path files;
		#! (type_lib_md5,files)
			= getMd5DigestFromFile temp_type_path files;
		#! md5_name
			= CREATE_ENCODED_LIBRARY_FILE_NAME (EXTRACT_FILE_NAME application_file_name) code_lib_md5 type_lib_md5;
					
		#! md5_code_path
			= CONVERT_ENCODED_LIBRARY_IDENTIFICATION_INTO_RUN_TIME_LIBRARY_IDENTIFICATION dynamic_linker_path (ADD_CODE_LIBRARY_EXTENSION md5_name);
		
		#! x
			= Just (ADD_CODE_LIBRARY_EXTENSION md5_name,temp_code_p,temp_type_p);
			
		#! ((_,md5_code_p),files)
			= pd_StringToPath md5_code_path files;
		#! (dir_error,files)
			= fmove OverwriteFile temp_code_p md5_code_p files;
//		| dir_error <> NoDirError
//			#! state
//				= AddMessage (LinkerError (make_dir_error_readable dir_error md5_code_path)) state;
//			= (x,state,platform_link_options,files);

		// rename type library					
		#! md5_type_path
			= CONVERT_ENCODED_LIBRARY_IDENTIFICATION_INTO_RUN_TIME_LIBRARY_IDENTIFICATION dynamic_linker_path (ADD_TYPE_LIBRARY_EXTENSION md5_name);

		#! ((_,md5_type_p),files)
			= pd_StringToPath md5_type_path files;		
		#! (dir_error,files)
		 	= fmove OverwriteFile temp_type_p md5_type_p files;
//		| dir_error <> NoDirError
//			#! state
//				= AddMessage (LinkerError (make_dir_error_readable dir_error md5_type_path)) state;
//			= (x,state,platform_link_options,files);

			= (x,state,platform_link_options,files);

import expand_8_3_names_in_path;

format_string list
	#! (n_elements,string_size)
		= foldSt compute_element_size list (0,0);
	#! string_size
		= (dec n_elements) + string_size;
	#! a
		= createArray string_size ' ';
	
	#! (l,a)
		= foldSt copy_element list (0,a);	
	| l == string_size
		= abort (toString l +++ " <> " +++ toString string_size);
	
		
	= abort ((toString n_elements) +++ " - " +++ toString string_size +++ " ---- '" +++ a +++ "'");
where {
	compute_element_size x (n_elements,string_size)
		= (inc n_elements,string_size + size x);
		
	copy_element x (i,a)
		# a = { a & [i + c] = x.[c] \\ c <- [0..dec (size x)] };
		= (i + size x + 1,a);
		
};

write_batch_file :: !String !String !String !*State !*Files -> (!Bool, String,!*State,!*Files);
write_batch_file application_file_name library_file_name dynamics_path state files
	#! (path_file,_)
		= ExtractPathFileAndExtension application_file_name;
	#! bat_file_name
		= path_file +++ ".bat";

	// open .bat-file
	#! (ok1,bat_file,files)
		= fopen bat_file_name FWriteText files;		
	// report error if occured
	| not ok1
		# error
			= LinkerError ("Error writing '" +++ path_file +++ ".bat'");
		# state
			= AddMessage error state;
		= (False,"",state,files);
	
	// FIXME: the dynamic path and options should be passed separately
	// by the Clean IDE to the static linker
	// split dynamic paths in proper path and Clean run-time options
	// (for example "-h 25M")
	# (dynamics_path, dynamic_linker_rts_options)
		=	split_dynamics_path_and_options dynamics_path
		with {
			split_dynamics_path_and_options :: {#Char} -> ({#Char}, {#Char});
			split_dynamics_path_and_options path_and_options
				// start at index 2, assume that a ':' at index 1
				// is the drive letter of the dynamics linker path
				// (for example C:\Clean\Tools\..)
				// (yes, this is quite crude)
				# (found,index)
					= CharIndex path_and_options 2 ':'
				| found
					= (path_and_options%(0,index-1), path_and_options%(index+1,size path_and_options));
				// otherwise
					= (path_and_options, "");
		}

	// start batch file with '@' to disable echo
	#! bat_file
		= fwritec '@' bat_file;
	// write path to dynamic linker
	#! bat_file
		= fwritec '\"' bat_file;
	#! bat_file
		= fwrites dynamics_path bat_file;
	#! bat_file
		= fwritec '\"' bat_file;
	#! bat_file
		= fwritec ' ' bat_file;

	// write Clean rts options for dynamic linker
	# bat_file
		= fwrites dynamic_linker_rts_options bat_file;
	# bat_file
		= fwritec ' ' bat_file;

	// write option to pass path of batch file to dynamic linker
	# bat_file
		= fwrites "--client-batch-file %0 " bat_file;

	#! (library_path_name,files)
		= case (FILE_IDENTIFICATION True False) of {
			True
				-> (library_file_name,files);
			_
		
				// get application name
				#! (_,application_file_name)
					= ExtractPathAndFile application_file_name;
				#! (application_file_name,_)
					= ExtractPathFileAndExtension application_file_name;
					
				// get root of dynamic linker
				#! (dynamic_linker_path,_)
					= ExtractPathAndFile dynamics_path;
					
				#! (library_path_name,files)
					= ds_generate_library_name application_file_name dynamic_linker_path files;
		
				-> (library_path_name,files);
		};
		
	// write application
	#! bat_file
		= fwritec '\"' bat_file;
	#! bat_file
		= fwrites library_path_name bat_file;
	#! bat_file
		= fwritec '\"' bat_file;

	// write arguments (passed from batch file to dynamic linker to executable)
	#! bat_file
		= foldl (flip fwrites) bat_file [" %" +++ toString i \\ i <- [1..9]];
	#! bat_file
		= fwritec '\n' bat_file;
		
	#! (ok2,files)
		= fclose bat_file files;
		
	// report error if occured
	| not ok2
		# error
			= LinkerError ("Error writing '" +++ path_file +++ ".bat'");
		# state
			= AddMessage error state;
		= (False,"",state,files)

	= (True,library_path_name,state,files);

add_clean_unwind_info_if_64_bits entry_datas names_table
	:== Link32or64bits
			(entry_datas,names_table)
			(add_clean_unwind_info entry_datas names_table);

add_clean_unwind_info entry_datas names_table
	# (clean_unwind_info_names_table_element,names_table)
		= find_symbol_in_symbol_table "clean_unwind_info" names_table;
	# (NamesTableElement _ clean_unwind_info_symbol_n clean_unwind_info_file_n _) = clean_unwind_info_names_table_element;
	# entry_datas = [(True,"",clean_unwind_info_file_n,clean_unwind_info_symbol_n) : entry_datas];
	= (entry_datas,names_table);

try_to_resolve_references_immediately xcoff_list 
	state=:{linker_state_info={one_pass_link,normal_static_link},namestable=names_table
		, application_name=application_file_name,
		n_libraries,n_xcoff_files,n_library_symbols,library_list,library_file_names} platform_link_options files
	#! allow_unused_undefined_symbols
		= ALLOW_UNUSED_DEFINED_SYMBOLS; // should be removed

	// resolve symbolic references by name
	#! (undefined_symbols,xcoff_list,names_table)
		= import_symbols_in_xcoff_files xcoff_list 0 [] names_table;
	| not (isEmpty undefined_symbols) && not allow_unused_undefined_symbols
		<<- ("%%%",undefined_symbols,allow_unused_undefined_symbols)
		# linker_messages_state
			= setLinkerMessages [LinkerError ("undefined symbol: " +++ symbol_name) \\ (symbol_name,_,_)<-undefined_symbols] DefaultLinkerMessages;
		= ({ EmptyState & linker_messages_state = linker_messages_state },platform_link_options,files);
		
	// check for the existence of main entry and any exported symbols
	# (main_entry_found,main_file_n,main_symbol_n,			// main entry
	   all_exported_symbols_found,entry_datas,				// exported symbols (found,symbol_name,file_n,symbol_n)
	   names_table,											// names table
	   platform_link_options)
	   	= find_root_symbols names_table platform_link_options;
	| not main_entry_found || not all_exported_symbols_found
		# undefined_main_entry
			= case main_entry_found of {
				True	-> [];
				False	-> ["Symbol \"main\" is not defined"];
			};
		# undefined_exported_entries
			= case all_exported_symbols_found of {
				True	-> [];
				False	-> [ ("Exported symbol \"" +++ name +++ "\" is not defined.") \\ (found,name,file_n,symbol_n) <- entry_datas | not found ];
			};
		# linker_messages_state
			= setLinkerMessages [LinkerError e \\ e <- (undefined_main_entry ++ undefined_exported_entries)] DefaultLinkerMessages;
		= ({ EmptyState & linker_messages_state = linker_messages_state },platform_link_options,files);

	# platform_link_options = plo_set_main_file_n_and_symbol_n main_file_n main_symbol_n platform_link_options

	// mark only used symbols
	# (entry_datas,names_table) = add_clean_unwind_info_if_64_bits entry_datas names_table
	# root_entries = [(True,"",main_file_n,main_symbol_n) : entry_datas];
	#! (unused_undefined_symbols,n_xcoff_symbols,marked_bool_a,marked_offset_a,xcoff_a,names_table)
		= mark_modules_list [] xcoff_list n_xcoff_files n_libraries n_library_symbols library_list root_entries names_table;
	| False //not (isEmpty undefined_symbols)
		# linker_messages_state
			= setLinkerMessages [LinkerError ("unused undefined symbol " +++ e) \\ e <- unused_undefined_symbols] DefaultLinkerMessages;
		= ({ EmptyState & linker_messages_state = linker_messages_state },platform_link_options,files);
	
	# linker_messages_state
		= setLinkerMessages [LinkerWarning ("unused undefined symbol " +++ e) \\ e <- unused_undefined_symbols] DefaultLinkerMessages;

/*
// PC; should be built-in
	// remove garbage from symbol table (only for static linker)
	#! (marked_bool_a,xcoff_a) 
		= case normal_static_link of {
			True
				-> remove_garbage_from_symbol_table 0 n_xcoff_files 0 marked_bool_a xcoff_a;
			False
				-> (marked_bool_a,xcoff_a);
		};
*/

/*
// MAC; Xcoff-executable should be built-in
	# (sections,platform_link_options)
		= plo_get_sections platform_link_options;
	# (ok,pef_application_size,files)
		= case /*generate_xcoff*/ False of { 
			False
				-> write_pef_file application_file_name n_xcoff_files n_libraries n_library_symbols library_list 
						main_symbol_n main_file_n one_pass_link sections 
						n_xcoff_symbols marked_bool_a marked_offset_a xcoff_a files;				
/*
uniek maken
			True
				-> write_xcoff_file application_file_name n_xcoff_files n_libraries n_library_symbols library_list 
						main_symbol_n main_file_n one_pass_link sections 
						n_xcoff_symbols marked_bool_a marked_offset_a xcoff_a files;
						//abort "link_xcoff_files: a xcoff executable not supported";
*/
		};
*/
	// create state
	# (base_va,platform_link_options) = plo_get_base_va platform_link_options;
	# linker_state_info = {	one_pass_link = one_pass_link, normal_static_link = normal_static_link,
							linker_state_base_va = base_va};
	#! state 
		= { EmptyState &
			// misc
				linker_state_info = linker_state_info
			// linker tables
			,	application_name		= application_file_name
			,	n_libraries				= n_libraries
			,	n_xcoff_files 			= n_xcoff_files
			,	n_xcoff_symbols			= n_xcoff_symbols
			,	n_library_symbols		= n_library_symbols
			
			,	marked_bool_a			= marked_bool_a
			,	marked_offset_a			= marked_offset_a
			,	xcoff_a 				= xcoff_a
			,	namestable				= names_table
		
			// dynamic libraries
			,	library_list 			= library_list
			,	library_file_names		= if normal_static_link [] (strip_paths_from_file_names library_file_names)
		};
	= (state,platform_link_options,files);
	
add_file_n_and_symbol_n_of_clean_unwind_info_if_64_bits file_n_and_symbol_n_of_entry_datas names_table
	:== Link32or64bits
			(file_n_and_symbol_n_of_entry_datas,names_table)
			(add_file_n_and_symbol_n_of_clean_unwind_info file_n_and_symbol_n_of_entry_datas names_table);

add_file_n_and_symbol_n_of_clean_unwind_info file_n_and_symbol_n_of_entry_datas names_table
	# (clean_unwind_info_names_table_element,names_table)
		= find_symbol_in_symbol_table "clean_unwind_info" names_table;
	# (NamesTableElement _ clean_unwind_info_symbol_n clean_unwind_info_file_n _) = clean_unwind_info_names_table_element;
	# file_n_and_symbol_n_of_entry_datas = [(clean_unwind_info_file_n,clean_unwind_info_symbol_n) : file_n_and_symbol_n_of_entry_datas]
	= (file_n_and_symbol_n_of_entry_datas,names_table);

check_presence_of_root_symbols state platform_link_options files
	# (names_table,state) = select_namestable state;

	// fix ...		
	# (names_table_element,names_table)
		= find_symbol_in_symbol_table "_start" names_table; 
	| not (isNamesTableElement names_table_element)
		# state = update_namestable names_table state;
		# state = AddMessage (LinkerError "The Start function of the application is undefined") state;
		= ([],state,platform_link_options,files);
	
	// check for the existence of main entry and any exported symbols
	# (main_entry_found,main_file_n,main_symbol_n,			// main entry
	   all_exported_symbols_found,entry_datas,				// exported symbols (found,symbol_name,file_n,symbol_n)
	   names_table,											// names table
	   platform_link_options)
	   	= find_root_symbols names_table platform_link_options;

	# file_n_and_symbol_n_of_entry_datas = [(file_n,symbol_n) \\ (True,_,file_n,symbol_n) <- entry_datas];
	# (file_n_and_symbol_n_of_entry_datas,names_table)
		= add_file_n_and_symbol_n_of_clean_unwind_info_if_64_bits file_n_and_symbol_n_of_entry_datas names_table;

	# state = update_namestable names_table state;
	| not main_entry_found || not all_exported_symbols_found
		# undefined_main_entry
			= case main_entry_found of {
				True
					-> [];
				False
					-> ["Symbol \"main\" is not defined"];
			};
		# undefined_exported_entries
			= case all_exported_symbols_found of {
				True
					-> [];
				False 
					-> [ ("Exported symbol \"" +++ name +++ "\" is not defined.") \\ (found,name,file_n,symbol_n) <- entry_datas | not found ];
			};
		# linker_messages_state
			= setLinkerMessages [LinkerError e \\ e <- (undefined_main_entry ++ undefined_exported_entries)] DefaultLinkerMessages;
		= ([],{ state & linker_messages_state = linker_messages_state },platform_link_options,files);
			
			
		# file_n_and_symbol_n_of_root_symbols
			= [ (main_file_n,main_symbol_n) : file_n_and_symbol_n_of_entry_datas];
		= (file_n_and_symbol_n_of_root_symbols,state,platform_link_options,files);
where {
	isNamesTableElement EmptyNamesTableElement	= False;
	isNamesTableElement	_						= True;
};
	
import selectively_import_and_mark_labels;
import utilities;

resolve_symbol_references_lazily xcoff_list 
		state=:{linker_state_info={normal_static_link},application_name=application_file_name,
		n_libraries,n_xcoff_files,n_library_symbols,library_list,library_file_names} platform_link_options files
	#! (n_xcoff_symbols,xcoff_list)
		= n_symbols_of_xcoff_list 0 xcoff_list;

	#! already_marked_bool_a 
		= createArray (n_xcoff_symbols+n_library_symbols) False;

	#! (marked_bool_a,marked_offset_a,xcoff_a)
		= create_xcoff_boolean_array n_xcoff_files n_xcoff_symbols n_libraries n_library_symbols library_list xcoff_list;
		
	#! (file_n_and_symbol_n_of_root_symbols,state,platform_link_options,files)
		= check_presence_of_root_symbols state platform_link_options files;		

	#! state 
		= { state &
			// misc
				n_xcoff_symbols			= n_xcoff_symbols
			
			,	marked_bool_a			= already_marked_bool_a
			,	marked_offset_a			= marked_offset_a
			,	xcoff_a 				= xcoff_a
		
			,	library_file_names		= if normal_static_link [] (strip_paths_from_file_names library_file_names)
		};
		
		
	#! (marked_bool_a,state)
		= foldSt (\(file_n,symbol_n) s -> selective_import_symbol file_n symbol_n s) file_n_and_symbol_n_of_root_symbols (marked_bool_a,state)

	#! state = { state & marked_bool_a = marked_bool_a };

// State

/*
	| True
		= abort "lazily_resolve_references";
		
	#! allow_unused_undefined_symbols
		= ALLOW_UNUSED_DEFINED_SYMBOLS; // should be removed

	// resolve symbolic references by name
	#! (undefined_symbols,xcoff_list,names_table)
		= import_symbols_in_xcoff_files xcoff_list 0 [] names_table;
	| not (isEmpty undefined_symbols) && not allow_unused_undefined_symbols
		<<- ("%%%",undefined_symbols,allow_unused_undefined_symbols)
		# linker_messages_state
			= setLinkerMessages [LinkerError ("undefined symbol: " +++ symbol_name) \\ (symbol_name,_,_)<-undefined_symbols] DefaultLinkerMessages;
		= ({ EmptyState & linker_messages_state = linker_messages_state },platform_link_options,files);
		
	// check for the existence of main entry and any exported symbols
	# (main_entry_found,main_file_n,main_symbol_n,			// main entry
	   all_exported_symbols_found,entry_datas,				// exported symbols (found,symbol_name,file_n,symbol_n)
	   names_table,											// names table
	   platform_link_options)
	   	= find_root_symbols names_table platform_link_options;
	| not main_entry_found || not all_exported_symbols_found
		# undefined_main_entry
			= case main_entry_found of {
				True
					-> [];
				False
					-> ["Symbol \"main\" is not defined"];
			};
		# undefined_exported_entries
			= case all_exported_symbols_found of {
				True
					-> [];
				False 
					-> [ ("Exported symbol \"" +++ name +++ "\" is not defined.") \\ (found,name,file_n,symbol_n) <- entry_datas | not found ];
			};
		# linker_messages_state
			= setLinkerMessages [LinkerError e \\ e <- (undefined_main_entry ++ undefined_exported_entries)] DefaultLinkerMessages;
		= ({ EmptyState & linker_messages_state = linker_messages_state },platform_link_options,files);

	# platform_link_options
		= plo_set_main_file_n_and_symbol_n main_file_n main_symbol_n platform_link_options

	// mark only used symbols
	# root_entries
		= [(True,"",main_file_n,main_symbol_n) : entry_datas];
	#! (unused_undefined_symbols,n_xcoff_symbols,marked_bool_a,marked_offset_a,xcoff_a,names_table)
		= mark_modules_list [] xcoff_list n_xcoff_files n_libraries n_library_symbols library_list root_entries names_table;
	| False //not (isEmpty undefined_symbols)
		# linker_messages_state
			= setLinkerMessages [LinkerError ("unused undefined symbol " +++ e) \\ e <- unused_undefined_symbols] DefaultLinkerMessages;
		= ({ EmptyState & linker_messages_state = linker_messages_state },platform_link_options,files);
	
	
	
	# linker_messages_state
		= setLinkerMessages [LinkerWarning ("unused undefined symbol " +++ e) \\ e <- unused_undefined_symbols] DefaultLinkerMessages;

	
	
	
	
		
/*
// PC; should be built-in
	// remove garbage from symbol table (only for static linker)
	#! (marked_bool_a,xcoff_a) 
		= case normal_static_link of {
			True
				-> remove_garbage_from_symbol_table 0 n_xcoff_files 0 marked_bool_a xcoff_a;
			False
				-> (marked_bool_a,xcoff_a);
		};
*/

/*
// MAC; Xcoff-executable should be built-in
	# (sections,platform_link_options)
		= plo_get_sections platform_link_options;
	# (ok,pef_application_size,files)
		= case /*generate_xcoff*/ False of { 
			False
				-> write_pef_file application_file_name n_xcoff_files n_libraries n_library_symbols library_list 
						main_symbol_n main_file_n one_pass_link sections 
						n_xcoff_symbols marked_bool_a marked_offset_a xcoff_a files;				
/*
uniek maken
			True
				-> write_xcoff_file application_file_name n_xcoff_files n_libraries n_library_symbols library_list 
						main_symbol_n main_file_n one_pass_link sections 
						n_xcoff_symbols marked_bool_a marked_offset_a xcoff_a files;
						//abort "link_xcoff_files: a xcoff executable not supported";
*/
		};
*/

*/
	= (state,platform_link_options,files);
	
	
// COT support
// -----------

:: COT
	= {
		cot_module_name			:: !String
	,	cot_path_file_object	:: !String
	, 	cot_md5_object			:: !Maybe String
	,	cot_path_file_tcl		:: !String
	,	cot_md5_tcl				:: !Maybe String
	};

write_cots application_file_name dynamics_path state file_names library_file_names static_libraries platform_link_options files
	// create cot info
	#! (cots,files)
		= mapSt create_cot file_names files
		with {
			create_cot cot_path_file_object files
				// module name
				#! (module_name,_)
					= ExtractPathFileAndExtension cot_path_file_object
				#! (_,module_name)
					= ExtractPathAndFile module_name
					
				
				// object md5
				#! (cot_md5_object,files)
					= getMd5DigestFromFile_ cot_path_file_object files;
					
				// tcl md5
				#! cot_path_file_tcl 
					= (fst (ExtractPathFileAndExtension cot_path_file_object)) +++ ".tcl"
				#! (cot_md5_tcl,files)
					= getMd5DigestFromFile_ cot_path_file_tcl files;

				// create cot
				#! cot
					= {
						cot_module_name			= module_name
					,	cot_path_file_object	= cot_path_file_object
					, 	cot_md5_object			= cot_md5_object
					,	cot_path_file_tcl		= cot_path_file_tcl
					,	cot_md5_tcl				= cot_md5_tcl
					}
				= (cot,files)
		}
		
	// create cot files
	#! (dynamic_linker_path,_)
		= ExtractPathAndFile dynamics_path;
	# (_,files)
		= ds_create_directory DS_COTS_DIR dynamic_linker_path files;
	
	#! files
		= foldSt create_cot_file cots files
		with {
			create_cot_file {cot_module_name,cot_md5_object,cot_md5_tcl,cot_path_file_object,cot_path_file_tcl} files
				// create path to cot file
				#! cot_file_name
					= cot_module_name +++ "$" +++ convert_maybe_md5 cot_md5_object +++ "_" +++ convert_maybe_md5 cot_md5_tcl
				#! cot_path_file_name
					= CONVERT_COTS_DIR_TO_PATH dynamic_linker_path cot_file_name;
					
				// create cot file
				#! (ok,cot_file,files)
					= fopen cot_path_file_name FWriteData files;
				| not ok
					= abort ("could not open file '" +++ cot_file_name +++ "'");
					
				// write header
				#! cot_file
					= write_cot_header cots cot_file
					
				// copy object and type file
				#! (fp_object,cot_file,files)
					= copy_cot_file cot_md5_object cot_path_file_object cot_file files;
				#! (fp_tcl,cot_file,files)
					= copy_cot_file cot_md5_tcl cot_path_file_tcl cot_file files;
						
				// patch
				#! cot_file
					= patch_cot_file fp_object COT_HEADER_FP_OBJECT cot_file
				#! cot_file
					= patch_cot_file fp_tcl COT_HEADER_FP_TCL cot_file
				
				//
				#! (_,files)
					= fclose cot_file files
				= files
		}
	
	| False <<- cots
		= undef;
	= (state,platform_link_options,files);

// ADD to module 'DynID' ...	
// Predefined directories (w.r.t. root-directory):
DS_COTS_DIR		:== "cots";

CONVERT_COTS_DIR_TO_PATH base_directory cot_file_name
	:== base_directory +++ "\\" +++ DS_COTS_DIR +++ "\\" +++ cot_file_name +++ ".cot";

// ... ADD to module 'DynID'

// TODO:
// - store MD5 in binary format
COT_HEADER_FP_OBJECT	:== 0;
COT_HEADER_FP_TCL		:== 4;

write_cot_header cots cot_file
	// fp object, COT_HEADER_FP_OBJECT
	#! cot_file = fwritei 0 cot_file;
	// fp tcl, COT_HEADER_FP_TCL
	#! cot_file = fwritei 0 cot_file;
	#! cot_file = fwritei n_cots cot_file;
	#! cot_file
		= foldSt write_cot_info cots cot_file
		with {
			write_cot_info {cot_module_name,cot_md5_object,cot_md5_tcl} cot_file
				// write cot_module_name
				#! cot_file = fwritei (size cot_module_name) cot_file;
				#! cot_file = fwrites cot_module_name cot_file;
				#! cot_file = fwrites (convert_maybe_md5 cot_md5_object) cot_file;
				#! cot_file = fwrites (convert_maybe_md5 cot_md5_tcl) cot_file;
				= cot_file
		};
	= cot_file;
where {
	n_cots = length cots;
}

convert_maybe_md5 Nothing
	= "00000000000000000000000000000000";
	// 12345678901234567890123456789012
convert_maybe_md5 (Just md5)
	= md5;
			
copy_file input_file_name output files
	# (ok,input,files) = fopen input_file_name FReadText files;
	| not ok
		= abort ("!could not open '" +++ input_file_name +++ "'");
		
	# (input,output)
		= copy_file_ input output; 
		with {
			copy_file_ src dst
				# (end_of_file,src) = fend src;
				| end_of_file
					= (src,dst);
				# (line,src) = freadline src;
				= copy_file_ src (fwrites line dst);
		};
	# (_,files) = fclose input files;
	= (output,files);

copy_cot_file Nothing file_name output files
	= (0,output,files);

copy_cot_file (Just _) file_name output files
	#! (fp,output) = fposition output;
	#! (output,files) = copy_file file_name output files;
	= (fp,output,files);

cot_seek fp cot_file
	#! (ok,cot_file) = fseek cot_file fp FSeekSet;
	| not ok
		= abort ("could not seek to " +++ toString fp);
		= cot_file;

patch_cot_file contents fp cot_file
	#! cot_file = cot_seek fp cot_file;
	= fwritei contents cot_file;
