(* A toploop that is running in a worker process. You also need to link with toplevellib.cma (see Makefile). There is a new directive #spawn which may be used to create new workers. Just quit them with #quit. Bad interaction with ledit: SIGINT from ledit is only sent to the master process but not to the whole process group. FIXME: SIGINT does not work properly *) module Unit_encap = Netplex_encap.Make_encap(struct type t = unit end) (* let () = Netmcore.Debug.enable := true *) let () = Toploop.set_paths () let _ = Topdirs.load_file (* just reference this module, so the directives get initialized *) let wd_fd = Unix.openfile "." [Unix.O_RDONLY] 0 let () = Netsys_signal.keep_away_from Sys.sigint; Sys.set_signal Sys.sigint Sys.Signal_ignore let run_toploop() = print_endline ("Netmcore: Starting toploop in worker child [PID=" ^ string_of_int (Unix.getpid()) ^ "]"); Netsys_posix.fchdir wd_fd; Sys.catch_break true; Toploop.loop Format.std_formatter; (* We never get here! *) exit 0 let toploop_fork, toploop_join = Netmcore.def_process (fun _ -> run_toploop(); Unit_encap.wrap () ) let spawn_toploop () = let pid = Netmcore.start ~inherit_resources:`All toploop_fork (Unit_encap.wrap()) in Sys.catch_break false; ignore(Netmcore.join toploop_join pid); Sys.catch_break true; print_endline ("Netmcore: Returning to toploop in worker child [PID=" ^ string_of_int (Unix.getpid()) ^ "]") let () = Hashtbl.add Toploop.directive_table "spawn" (Toploop.Directive_none spawn_toploop) let () = Netmcore.startup ~socket_directory:"/tmp/t_toploop" ~first_process:(fun() -> Netmcore.start toploop_fork (Unit_encap.wrap())) ()