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 805 - (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 805 | ["cmb", db, archos, f] => (dbr := db; do_cmb (archos, f))
36 :     | ["reset_cmb", archos] => reset_cmb archos
37 : blume 480 | ["ping"] => (say_pong (); waitForStart ())
38 :     | ["finish"] => (say_ok (); waitForStart ())
39 :     | ["shutdown"] => shutdown ()
40 :     | _ => (say_error (); waitForStart ())
41 :     end handle _ => (say_error (); waitForStart ())
42 :    
43 : blume 632 and reset_cmb archos = let
44 :     val slave = CMBSlave.slave make
45 :     in
46 : blume 805 ignore (slave archos NONE); (* causes reset *)
47 : blume 632 say_ok ();
48 :     waitForStart ()
49 :     end
50 :    
51 : blume 480 and do_cmb (archos, f) = let
52 :     val slave = CMBSlave.slave make
53 :     in
54 : blume 632 case slave archos (SOME (!dbr, f)) of
55 : blume 480 NONE => (say_error (); waitForStart ())
56 : blume 666 | SOME (g, trav, cmb_penv) => let
57 : blume 480 val _ = say_ok ()
58 :     val index = Reachable.snodeMap g
59 :     in
60 : blume 666 workLoop (index, trav, cmb_penv)
61 : blume 480 end
62 :     end handle _ => (say_error (); waitForStart ())
63 :    
64 :     and do_cm (archos, f) =
65 :     if archos <> my_archos then (say_error (); waitForStart ())
66 :     else let
67 : blume 666 val p = path (f, penv)
68 : blume 480 in
69 :     case parse p of
70 :     NONE => (say_error (); waitForStart ())
71 :     | SOME (g, gp) => let
72 :     val _ = say_ok ()
73 :     val index = Reachable.snodeMap g
74 : blume 771 val trav = sbtrav ()
75 :     fun trav' sbn = isSome (trav sbn gp)
76 : blume 480 in
77 : blume 666 workLoop (index, trav', penv)
78 : blume 480 end
79 :     end handle _ => (say_error (); waitForStart ())
80 :    
81 : blume 666 and workLoop (index, trav, penv) = let
82 : blume 480 fun loop () = let
83 :     val line = TextIO.inputLine TextIO.stdIn
84 :     in
85 :     if line = "" then shutdown ()
86 :     else case String.tokens Char.isSpace line of
87 :     ["cd", d] => (chDir d; say_ok (); loop ())
88 :     | ["compile", f] => let
89 : blume 666 val p = path (f, penv)
90 : blume 480 in
91 :     case SrcPathMap.find (index, p) of
92 :     NONE => (say_error (); loop ())
93 :     | SOME sn => let
94 :     val sbn = DG.SB_SNODE sn
95 :     in
96 :     if trav sbn then (say_ok (); loop ())
97 :     else (say_error (); loop ())
98 :     end
99 :     end
100 :     | ["cm", archos, f] => do_cm (archos, f)
101 : blume 805 | ["cmb", db, archos, f] => (dbr := db; do_cmb (archos, f))
102 :     | ["reset_cmb", archos] => reset_cmb archos
103 : blume 480 | ["finish"] => (say_ok (); waitForStart ())
104 :     | ["ping"] => (say_pong (); loop ())
105 :     | ["shutdown"] => shutdown ()
106 :     | _ => (say_error (); loop ())
107 :     end handle _ => (say_error (); loop ())
108 :     in
109 :     loop ()
110 :     end
111 :     in
112 :     ignore (Signals.setHandler (Signals.sigINT, Signals.IGNORE));
113 :     say_ok (); (* announce readiness *)
114 :     waitForStart () handle _ => ();
115 :     OS.Process.exit OS.Process.failure
116 :     end
117 :     end
118 :     end

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