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; 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) // computing address descriptor table , (False,"ComputeDescAddressTable",ComputeDescAddressTable) // compute address descriptor table using the descriptor usage set , (False,"Compute2DescAddressTable",ComputeDescAddressTable2) // 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 , (False,"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);