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

SCM Repository

[smlnj] Diff of /sml/trunk/src/cm/bootstrap/btcompile.sml
ViewVC logotype

Diff of /sml/trunk/src/cm/bootstrap/btcompile.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 804, Thu Mar 22 19:37:34 2001 UTC revision 805, Thu Mar 22 20:08:01 2001 UTC
# Line 31  Line 31 
31    
32      val archos = concat [arch, "-", osname]      val archos = concat [arch, "-", osname]
33    
     fun init_servers (GG.GROUP { grouppath, ... }) =  
         Servers.cmb { archos = archos,  
                       root = SrcPath.encode grouppath }  
       | init_servers GG.ERRORGROUP = ()  
   
34      structure StabModmap = StabModmapFn ()      structure StabModmap = StabModmapFn ()
35    
36      structure Compile = CompileFn (structure MachDepVC = MachDepVC      structure Compile = CompileFn (structure MachDepVC = MachDepVC
# Line 88  Line 83 
83          MkBootList.group listName g          MkBootList.group listName g
84      end      end
85    
     local  
86          fun internal_reset () =          fun internal_reset () =
87              (Compile.reset ();              (Compile.reset ();
88               Parse.reset ();               Parse.reset ();
89               StabModmap.reset ())               StabModmap.reset ())
90      in  
91          fun reset () =          fun reset () =
92              (Say.vsay ["[CMB reset]\n"];              (Say.vsay ["[CMB reset]\n"];
93             Servers.withServers (fn () => Servers.cmb_reset { archos = archos });
94               internal_reset ())               internal_reset ())
95    
96          val checkDirbase = let          val checkDirbase = let
97              val prev = ref NONE              val prev = ref NONE
98              fun ck db =              fun ck db =
# Line 111  Line 107 
107          in          in
108              ck              ck
109          end          end
     end  
110    
111      fun mk_compile { master, root, dirbase = dbopt } = let      fun mk_compile { master, root, dirbase = dbopt } = let
112    
# Line 251  Line 246 
246              in              in
247                  if master then                  if master then
248                      case Stabilize.stabilize ginfo stabarg of                      case Stabilize.stabilize ginfo stabarg of
249                          SOME g => g                          SOME g => (Parse.reset (); g)
250                        | NONE => raise Fail "CMB: cannot stabilize init group"                        | NONE => raise Fail "CMB: cannot stabilize init group"
251                  else g0                  else g0
252              end              end
# Line 292  Line 287 
287    
288              val lonely_master = master andalso Servers.noServers ()              val lonely_master = master andalso Servers.noServers ()
289    
290              val initial_parse_arg =              val initial_parse_result =
291                  if lonely_master then parse_arg (SOME true, true)                  if master then
292                  else parse_arg (NONE, master)                      if lonely_master then
293                            (* no slaves available; do everything alone *)
294                            Parse.parse (parse_arg (SOME true, true))
295                        else
296                            (* slaves available; we want master
297                             * and slave initialization to overlap, so
298                             * we do the master's parsing in its own
299                             * thread *)
300                            let fun worker () = let
301                                    val c =
302                                        Concur.fork
303                                            (fn () => Parse.parse
304                                                          (parse_arg (NONE, true)))
305                                in
306                                    Servers.cmb
307                                        { dirbase = dirbase,
308                                          archos = archos,
309                                          root = SrcPath.encode maingspec };
310                                    Concur.wait c
311                                end
312                            in
313                                Servers.withServers worker
314                            end
315                    else
316                        (* slave case *)
317                        Parse.parse (parse_arg (NONE, false))
318    
319          in          in
320              case Parse.parse initial_parse_arg of              case initial_parse_result of
321                  NONE => NONE                  NONE => NONE
322                | SOME (g, gp) => let                | SOME (g, gp) => let
323                      fun finish (g, gp) = let                      fun finish (g, gp) = let
# Line 369  Line 390 
390                      (* the following thunk is executed in "master" mode only;                      (* the following thunk is executed in "master" mode only;
391                       * slaves just throw it away *)                       * slaves just throw it away *)
392                      fun compile_and_stabilize () = let                      fun compile_and_stabilize () = let
                         (* this ought to be consolidated (from 3 make 1)... *)  
                         val _ = Servers.dirbase dirbase  
                         val _ = Servers.cmb_new { archos = archos }  
                         val _ = Servers.cmb { archos = archos,  
                                               root = SrcPath.encode maingspec }  
393    
394                          (* make compilation traversal and execute it *)                          (* make compilation traversal and execute it *)
395                          val { allgroups, ... } =                          val { allgroups, ... } =
# Line 404  Line 420 
420          (StabModmap.reset ();          (StabModmap.reset ();
421           case mk_compile { master = true, root = NONE, dirbase = dbopt } of           case mk_compile { master = true, root = NONE, dirbase = dbopt } of
422               NONE => false               NONE => false
423             | SOME (_, cas) => cas ())             | SOME (_, thunk) => thunk ())
424    
425      local      local
426          fun slave NONE = (StabModmap.reset (); NONE)          fun slave NONE = (internal_reset (); NONE)
427            | slave (SOME (dirbase, root)) =            | slave (SOME (dirbase, root)) =
428                (StabModmap.reset ();
429              case mk_compile { master = false, root = SOME root,              case mk_compile { master = false, root = SOME root,
430                                dirbase = SOME dirbase } of                                dirbase = SOME dirbase } of
431                  NONE => NONE                  NONE => NONE
# Line 417  Line 434 
434                      fun trav' sbn = isSome (trav sbn gp)                      fun trav' sbn = isSome (trav sbn gp)
435                  in                  in
436                      SOME (g, trav', penv)                      SOME (g, trav', penv)
437                  end                   end)
438      in      in
439          val _ = CMBSlaveHook.init archos slave          val _ = CMBSlaveHook.init archos slave
440      end      end

Legend:
Removed from v.804  
changed lines
  Added in v.805

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