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 651 - (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 :     fun slave { pcmode, my_archos, parse, sbtrav, make } = let
15 :    
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 :     fun path (s, pcmode) = SrcPath.fromDescr pcmode s
24 :    
25 :     fun chDir d =
26 :     OS.FileSys.chDir (SrcPath.osstring (path (d, pcmode)))
27 :    
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 :     | SOME (g, trav, cmb_pcmode) => let
59 :     val _ = say_ok ()
60 :     val index = Reachable.snodeMap g
61 :     in
62 :     workLoop (index, trav, cmb_pcmode)
63 :     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 :     val p = path (f, pcmode)
70 :     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 :     val trav = sbtrav () gp
77 :     fun trav' sbn = isSome (trav sbn)
78 :     in
79 :     workLoop (index, trav', pcmode)
80 :     end
81 :     end handle _ => (say_error (); waitForStart ())
82 :    
83 :     and workLoop (index, trav, pcmode) = let
84 :     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 :     val p = path (f, pcmode)
92 :     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