← Back to branch summary

~ubuntu-branches/ubuntu/trusty/ocamlnet/trusty

« back to all changes in this revision

Viewing changes to src/netmulticore/t_toploop.ml

  • Committer: Bazaar Package Importer
  • Author(s): Stéphane Glondu
  • Date: 2011-09-02 14:12:33 UTC
  • mfrom: (18.2.3 sid)
  • Revision ID: james.westby@ubuntu.com-20110902141233-zbj0ygxb92u6gy4z
Tags: 3.4-1
http://bugs.debian.org/637147
* New upstream release
  - add a new NetcgiRequire directive to ease dependency management
    (Closes: #637147)
  - remove patches that were applied upstream:
    + Added-missing-shebang-lines-in-example-shell-scripts
    + Try-also-ocamlc-for-POSIX-threads

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/netmulticore/t_toploop.ml
 
1
(* A toploop that is running in a worker process. You also need to
 
2
   link with toplevellib.cma (see Makefile).
 
3
 
 
4
   There is a new directive #spawn which may be used to create new
 
5
   workers. Just quit them with #quit.
 
6
 
 
7
   Bad interaction with ledit: SIGINT from ledit is only sent to the
 
8
   master process but not to the whole process group.
 
9
 
 
10
   FIXME: SIGINT does not work properly
 
11
 *)
 
12
 
 
13
module Unit_encap = Netplex_encap.Make_encap(struct type t = unit end)
 
14
 
 
15
(*
 
16
let () =
 
17
  Netmcore.Debug.enable := true
 
18
 *)
 
19
 
 
20
let () =
 
21
  Toploop.set_paths ()
 
22
 
 
23
let _ =
 
24
  Topdirs.load_file
 
25
  (* just reference this module, so the directives get initialized *)
 
26
 
 
27
let wd_fd =
 
28
  Unix.openfile "." [Unix.O_RDONLY] 0
 
29
 
 
30
let () =
 
31
  Netsys_signal.keep_away_from Sys.sigint;
 
32
  Sys.set_signal Sys.sigint Sys.Signal_ignore
 
33
 
 
34
let run_toploop() =
 
35
  print_endline 
 
36
    ("Netmcore: Starting toploop in worker child [PID=" ^ 
 
37
       string_of_int (Unix.getpid()) ^ "]");
 
38
  Netsys_posix.fchdir wd_fd;
 
39
  Sys.catch_break true;
 
40
  Toploop.loop Format.std_formatter;
 
41
    (* We never get here! *)
 
42
  exit 0
 
43
 
 
44
let toploop_fork, toploop_join =
 
45
  Netmcore.def_process
 
46
    (fun _ ->
 
47
       run_toploop();
 
48
       Unit_encap.wrap ()
 
49
    )
 
50
 
 
51
let spawn_toploop () =
 
52
  let pid =
 
53
    Netmcore.start ~inherit_resources:`All toploop_fork (Unit_encap.wrap()) in
 
54
  Sys.catch_break false;
 
55
  ignore(Netmcore.join toploop_join pid);
 
56
  Sys.catch_break true;
 
57
  print_endline 
 
58
    ("Netmcore: Returning to toploop in worker child [PID=" ^ 
 
59
       string_of_int (Unix.getpid()) ^ "]")
 
60
 
 
61
let () =
 
62
  Hashtbl.add Toploop.directive_table
 
63
    "spawn"
 
64
    (Toploop.Directive_none spawn_toploop)
 
65
 
 
66
let () =
 
67
  Netmcore.startup
 
68
    ~socket_directory:"/tmp/t_toploop"
 
69
    ~first_process:(fun() -> Netmcore.start toploop_fork (Unit_encap.wrap()))
 
70
    ()