Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/cm/main/slave.sml
ViewVC logotype

Annotation of /sml/trunk/src/cm/main/slave.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 771 - (view) (download)

1 : blume 480 (*
2 :     * This module implements the slave-side of the master-slave protocol used
3 :     * for parallel make.
4 :     *
5 :     * Copyright (c) 1999 by Lucent Bell Laboratories
6 :     *
7 :     * author: Matthias Blume (blume@cs.princeton.edu)
8 :     *)
9 :     local
10 :     structure DG = DependencyGraph
11 :     in
12 :     structure Slave = struct
13 :    
14 : blume 666 fun slave { penv, my_archos, parse, sbtrav, make } = let
15 : blume 480
16 :     val dbr = ref BtNames.dirbaseDefault
17 :    
18 :     fun shutdown () = OS.Process.exit OS.Process.success
19 :     fun say_ok () = Say.say ["SLAVE: ok\n"]
20 :     fun say_error () = Say.say ["SLAVE: error\n"]
21 :     fun say_pong () = Say.say ["SLAVE: pong\n"]
22 :    
23 : blume 666 fun path (s, penv) = SrcPath.decode penv s
24 : blume 480
25 :     fun chDir d =
26 : blume 666 OS.FileSys.chDir (SrcPath.osstring (path (d, penv)))
27 : blume 480
28 :     fun waitForStart () = let
29 :     val line = TextIO.inputLine TextIO.stdIn
30 :     in
31 :     if line = "" then shutdown ()
32 :     else case String.tokens Char.isSpace line of
33 :     ["cd", d] => (chDir d; say_ok (); waitForStart ())
34 :     | ["cm", archos, f] => do_cm (archos, f)
35 : blume 632 | ["cmb", archos] => reset_cmb archos
36 : blume 480 | ["cmb", archos, f] => do_cmb (archos, f)
37 :     | ["ping"] => (say_pong (); waitForStart ())
38 :     | ["finish"] => (say_ok (); waitForStart ())
39 :     | ["dirbase", db] =>
40 :     (say_ok (); dbr := db; waitForStart ())
41 :     | ["shutdown"] => shutdown ()
42 :     | _ => (say_error (); waitForStart ())
43 :     end handle _ => (say_error (); waitForStart ())
44 :    
45 : blume 632 and reset_cmb archos = let
46 :     val slave = CMBSlave.slave make
47 :     in
48 :     ignore (slave archos NONE);
49 :     say_ok ();
50 :     waitForStart ()
51 :     end
52 :    
53 : blume 480 and do_cmb (archos, f) = let
54 :     val slave = CMBSlave.slave make
55 :     in
56 : blume 632 case slave archos (SOME (!dbr, f)) of
57 : blume 480 NONE => (say_error (); waitForStart ())
58 : blume 666 | SOME (g, trav, cmb_penv) => let
59 : blume 480 val _ = say_ok ()
60 :     val index = Reachable.snodeMap g
61 :     in
62 : blume 666 workLoop (index, trav, cmb_penv)
63 : blume 480 end
64 :     end handle _ => (say_error (); waitForStart ())
65 :    
66 :     and do_cm (archos, f) =
67 :     if archos <> my_archos then (say_error (); waitForStart ())
68 :     else let
69 : blume 666 val p = path (f, penv)
70 : blume 480 in
71 :     case parse p of
72 :     NONE => (say_error (); waitForStart ())
73 :     | SOME (g, gp) => let
74 :     val _ = say_ok ()
75 :     val index = Reachable.snodeMap g
76 : blume 771 val trav = sbtrav ()
77 :     fun trav' sbn = isSome (trav sbn gp)
78 : blume 480 in
79 : blume 666 workLoop (index, trav', penv)
80 : blume 480 end
81 :     end handle _ => (say_error (); waitForStart ())
82 :    
83 : blume 666 and workLoop (index, trav, penv) = let
84 : blume 480 fun loop () = let
85 :     val line = TextIO.inputLine TextIO.stdIn
86 :     in
87 :     if line = "" then shutdown ()
88 :     else case String.tokens Char.isSpace line of
89 :     ["cd", d] => (chDir d; say_ok (); loop ())
90 :     | ["compile", f] => let
91 : blume 666 val p = path (f, penv)
92 : blume 480 in
93 :     case SrcPathMap.find (index, p) of
94 :     NONE => (say_error (); loop ())
95 :     | SOME sn => let
96 :     val sbn = DG.SB_SNODE sn
97 :     in
98 :     if trav sbn then (say_ok (); loop ())
99 :     else (say_error (); loop ())
100 :     end
101 :     end
102 :     | ["cm", archos, f] => do_cm (archos, f)
103 :     | ["cmb", archos, f] => do_cmb (archos, f)
104 :     | ["finish"] => (say_ok (); waitForStart ())
105 :     | ["dirbase", db] =>
106 :     (say_ok (); dbr := db; waitForStart ())
107 :     | ["ping"] => (say_pong (); loop ())
108 :     | ["shutdown"] => shutdown ()
109 :     | _ => (say_error (); loop ())
110 :     end handle _ => (say_error (); loop ())
111 :     in
112 :     loop ()
113 :     end
114 :     in
115 :     ignore (Signals.setHandler (Signals.sigINT, Signals.IGNORE));
116 :     say_ok (); (* announce readiness *)
117 :     waitForStart () handle _ => ();
118 :     OS.Process.exit OS.Process.failure
119 :     end
120 :     end
121 :     end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0