module DynamicLinker2;

import StdEnv, deltaEventIO, deltaMenu, deltaWindow, deltaTimer, deltaDialog;

//import Communication;
import DynamicLink;
// import DebugUtilities;
import DLState;

import ArgEnv;
import ExtFile;
import ExtString;
from ReadState import ReadState;
import UnknownModuleOrSymbol;
import ObjectToMem;

//import pdDynamicLinker2;
import ExtFile;
import ExtInt;

// Extension to library 0.8.1
//import ExtFile_IO081;
//import deltaIOState;
from handler import InstallDDEHandler;
import ClientWindow;
// OpenNotice
import DebugUtilities;
//F a b :== b;

// IDE 2.0
import target;

import Request;

import ExtString;
from pdRequest import ParseCommandLine;
import RWSDebugChoice;

import link_switches; 
// Version

/*
	To be done:
	
	- GUI interface (.o/.abc, .obj and lib support)
	- the .lib-field of the DynamicProjectInfo should be searched.
	- IDE 2.0: make accessor functions
	- port to Windows NT/2000 (might be that Handle-bug, documented in c-source)

*/

Start :: *World -> *World;
Start world
	#! world
		// if is not first instance then the commandline is copied to first instance of the dynamic linker
		= case /*is_first_instance*/ True of {
			True
				| (FirstInstanceOfServer2 is_first_instance) 
				// init FirstInstance2
				#! start_state
					= DefaultDLServerState;
				#! (_,world)		
					= StartIO [menus, timer] start_state [init_io, system_dependent_initial_io] world;
				-> world;
				
			_
				-> world;
		};
	= world
where {
	init_io :: !*DLServerState !*(IOState !*DLServerState) -> !*(!*DLServerState,!*IOState !*DLServerState);
	init_io s io
		// no arguments?
		# cmd_line
			= getCommandLine;

		| size cmd_line <= 1
			= abort "DynamicLinker needs an argument";
/*
			= case test_dynamic_linker of  {
				False
					-> error ["empty commandline"] s io;
				_
					# cmd_line
//						= {"C:\\WINDOWS\\DESKTOP\\Clean\\DynamicLinker","C:\\WINDOWS\\DESKTOP\\CLEAN\\DYNAMICS\\EXAMPLES\\THESIS~1\\testc.lib a b c d"};
						= {"C:\\WINDOWS\\DESKTOP\\Clean\\DynamicLinker","C:\WINDOWS\DESKTOP\CLEAN\DYNAMICS\EXAMPLES\WRITED~1\WriteDynamicc.lib a b c d"};
					# s
						= { s &
							dlss_lib_mode			= True
						,	dlss_lib_command_line	= {} //cmd_line //build_cmdline_in_addclient_format 1 (size cmd_line) cmd_line
						
						// set application path
						, 	application_path		=  fst (ExtractPathAndFile cmd_line.[0])
						};
					# (s,io)
						= InitServerState s io;
					-> (s,io);
			}
*/

		// compatibility mode
		# option
			= cmd_line.[1];
		| (size cmd_line == 2) && ((option == "/W") || (option  == "/w"))
			# project_name
				= cmd_line.[2];

			// read environments
			# application_path
				= (ParseCommandLine GetDynamicLinkerPath).[0];

			# (sep_found,sep_index)
				= CharIndexBackwards application_path (size application_path - 1) path_separator;
			| not sep_found
				= abort ("could not read IDEEnvs");
			
			# application_path
				= application_path % (0,dec sep_index);
//			# (ok,targets,io)
//				= openTargets (application_path +++ toString path_separator +++ "IDEEnvs") io;
//			| not ok
//				= abort (application_path +++ toString path_separator +++ "IDEEnvs");
				
			# s
				= { s &
					application_path				= application_path
				,	static_application_as_client	= (option == "/W") || (option  == "/w")
//				,	targets							= targets
				};
			# (s,io)
				= InitServerState s io;
			= (s,io);
			
			
			# s
				= { s &
					dlss_lib_mode			= True
				,	dlss_lib_command_line	= cmd_line //build_cmdline_in_addclient_format 1 (size cmd_line) cmd_line
				
				// set application path
				, 	application_path		=  fst (ExtractPathAndFile cmd_line.[0])
				};
			# (s,io)
				= InitServerState s io;

			= (s,io);
	where {
		build_cmdline_in_addclient_format :: !Int !Int {{#Char}} -> {#Char};
		build_cmdline_in_addclient_format i limit cmd_line
			| i == limit
				= "";
				= cmd_line.[i] +++ (if (i == (dec limit)) "" " ") +++ (build_cmdline_in_addclient_format (inc i) limit cmd_line);
	
	};

/*
	init_io s io
		= init_server s io;
	where {
		// windows specific
		init_server s io
			#! commandline
				= getCommandLine;
			#! (option,project_name,s,io)
				= case (size commandline) of {
					1
						#! (s,io)
							= error ["No project file"] s io; //(QuitIO (DisableTimer timer_id io));
						-> ("","",{ s & quit_server = True} ,io);
					2
						/*
						**	(wait) option; used with an eagerly linked and no running dynamic linker to prevent
						**	the dynamic linker from terminating immediately.
						*/
						-> (commandline.[1],"",s,io);
					3
						/*
						**  lazily linked application; snd commandline parameters specificies the project to
						**	be dynamically linked.
						*/
						-> (commandline.[1],commandline.[2],s,io);
//					_
//						-> abort (print_cmd_line 0 (size commandline) "" commandline);
				};
				
			#! (quit_server,s)
				= s!quit_server;
			#! (s,io)
				= case quit_server of {
					False
						// read environments
						#! application_path
							= (ParseCommandLine GetDynamicLinkerPath).[0];
					//	| True
					//		-> abort ("gevonden path: <" +++ application_path +++ ">")
							
							
					//		= fst (ExtractPathAndFile commandline.[0]);
						#! (sep_found,sep_index)
							= CharIndexBackwards application_path (size application_path - 1) path_separator;
						| not sep_found
							-> abort ("could not read IDEEnvs");
						
						#! application_path
							= application_path % (0,dec sep_index);
						#! (ok,targets,io)
							= openTargets (application_path +++ toString path_separator +++ "IDEEnvs") io;
						| not ok
							-> abort (application_path +++ toString path_separator +++ "IDEEnvs");
							
						#! s
							= { s &
								application_path				= application_path
							,	static_application_as_client	= (option == "/W") || (option  == "/w")
							,	targets							= targets
							};
						#! (s,io)
							= InitServerState s io;
						-> (s,io);
					True
						-> (s,io);
				};
			= (s,io);	
	} // init_io
	*/
		
	menus::.(DeviceSystem *DLServerState *(IOState *DLServerState));
	menus
		=  MenuSystem [	
			PullDownMenu file_menu_id "File" Able [	
					MenuItem quit_id "Quit" (Key 'Q') Able (\s io -> (s,QuitIO io))
				]
			];
		
	timer::.(DeviceSystem *DLServerState *(IOState *DLServerState));	
	timer
		= TimerSystem [Timer timer_id Able 0 (\q s io -> any_clients_left (t2 q s io))];

	[file_menu_id,quit_id:_] 
			= [1..];
			
	// windows ...
//	system_dependent_initial_io :: _ !*DLServerState !(IOState !*DLServerState) -> _;
	system_dependent_initial_io
		= InstallDDEHandler openDDE;
	where {
		openDDE file_name
				= abort ("openDDE: " +++ file_name);
	}	
	
}

print_cmd_line :: !Int !Int a {#{#Char}} -> {#Char};
print_cmd_line i limit s commandline
	| i == limit
		= "";
	# q
		= print_cmd_line (inc i) limit s commandline
	= commandline.[i] +++ " " +++ q;

// windows specific
t2 :: .a !*DLServerState *(IOState *DLServerState) -> *(*DLServerState,*IOState *DLServerState);
t2 _ s=:{quit_server,dlss_lib_mode=True,dlss_lib_command_line} io
	// matches only when there is no other dynamic rts running
	# s
		= { s &
			dlss_lib_mode	= False
		};
	#! (timeout,_,_)
		= ReceiveReqWithTimeOutE True;
	| timeout || not timeout
	# (remove_state,client_id,s,io)
		= AddClient3 DefaultProcessSerialNumber [ arg \\ arg <-: dlss_lib_command_line] s io;		
		= HandleRequestResult (remove_state,client_id,s,io);
		
t2 _ s=:{quit_server,static_application_as_client} io
//	| F "*" quit_server 
//		= (s,QuitIO (DisableTimer timer_id io));
	#! (timeout,client_id,request_name)
		= ReceiveReqWithTimeOutE static_application_as_client;
	| timeout
		= (s,io);

	#! s 
		= { s &
			static_application_as_client	= False
		};
	#! requests
		= filter (\(_,name,_) -> (fst (starts name request_name))) RequestList;

	| F request_name (length requests) == 1
		// extract arguments and execute request
		#! request
			= hd requests;
		#! request_args
			= case (fst3 request) of {
				True
					-> tl (ExtractArguments '\n' 0 request_name []);
				False
					#! index
						= size (snd3 request);
					-> [request_name % (index, size request_name - 1)];
			};
		
		// do request
		#! (remove_state,client_id,s,io)
			= (thd3 (hd requests)) client_id request_args s io;
			
		= HandleRequestResult (remove_state,client_id,s,io);
			
		#! (s,io)
			= error ["incoming request '" +++ request_name +++ "' unknown (" +++ toString (size request_name) +++ ")" +++ "\nInternal error"] s io;
		= (s,io);
where {
	// If requests have common prefixes, then the first request with the common prefix is used.
	RequestList
		= [
			// eagerly linked applications
			(True,"AddAndInit",AddAndInitPC)					// (is_special,STRING id,function handling request)
		
			// lazily linked applications
		,	(True,"AddClient",AddClient)
		,	(True,"Init",Init)
			
			// adding code
		,	(True,"AddLabel",AddLabel)
		
			// adding descriptors
		,	(False,"AddDescriptors",AddDescriptors)
		
		
			// computing address descriptor table
		,	(False,"ComputeDescAddressTable",ComputeDescAddressTable)
		
		
			// compute address descriptor table using the descriptor usage set
		,	(False,"Compute2DescAddressTable",ComputeDescAddressTable2)

			// get type info
		,	(False,"GetLibraryInfo",GetLibraryInfo)

			// get type info
		,	(False,"GetTypeTablePath",GetTypeTablePath)
		
			// adding addresses
		,	(False,"GetAddresses",GetAddresses)
		
			// add a project
		, 	(False,"AddProject",AddProject)
		
			// get address of the graph to string function
		,	(False,"GetGraphToStringFunction",GetGraphToStringFunction)
/*
			// adding project paths
		,	(False,"AddPaths",AddPaths)
*/		 
			// closing client
		,	(True,"Close",Close)
		
			// general
		,	(True,"Quit",Quit)
		
			// libinit
//		,	(True,"LibInit",LibInit) 
		
			// send by second or later instance of dynamic rts to first instance of dynamic rts
		,	(True,"MessageFromSecondOrLaterLinker",MessageFromSecondOrLaterLinker)
		
			// send to get extra dynamic rts information
		,	(False,"GetDynamicRTSInfo",GetDynamicRTSInfo)
		
			// check type definitions
		,	(False,"CheckTypeDefinitions",CheckTypeDefinitions)

			// Loads an application from a library
		,	(True,"LibInit",LoadApplication)
		
			// dumpDynamic is the caller
		,	(False,"DumpDynamic",DumpDynamic)
		
			// adding addresses
		,	(False,"GetLabelAddresses",GetLabelAddresses)

			// register lazy dynamic
		,	(False,"RegisterLazyDynamic",RegisterLazyDynamic)


		];
}

	any_clients_left (s=:{quit_server,global_client_window={visible_window_ids}},io)
		// update window
		#! (no_more_clients,s)
			= acc_dl_client_states is_empty s;
		#! (static_application_as_client,s)
			= s!static_application_as_client;
		| (not no_more_clients || static_application_as_client || (not (isEmpty visible_window_ids))) && (not quit_server)
			= (s,io);
			= (s,QuitIO io);
	where {
		is_empty []
			= (True,[]);
		is_empty l
			= (False,l);
			// DLServerState
	}	
// EnableTimer

AddAndInitPC :: !ProcessSerialNumber [{#Char}] *DLServerState *(IOState *DLServerState) -> *(Bool,ProcessSerialNumber,*DLServerState,*IOState *DLServerState);
AddAndInitPC client_id [commandline] s io
	// extract executable name
	#! parsed_command_line
		= ParseCommandLine commandline;
	= AddAndInit client_id [ p \\ p <-: parsed_command_line ] s io;
AddAndInitPC client_id q=:[commandline,do_add_project] s io
	#! parsed_command_line
		= ParseCommandLine commandline;
		= AddAndInit client_id ([ p \\ p <-: parsed_command_line ] ++ [do_add_project]) s io;
AddAndInitPC _ l s io
	= abort ("AddAndInitPC" +++ toString (length l));
	
error l s io
	#! io
		= DisableTimer timer_id io;
	#! (i,s,io)
		= OpenNotice (Notice ["Fatal error:":l] (NoticeButton 0 "Ok") []) s io;
	#! io
		= EnableTimer timer_id io;
	= (s, io);