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 449, Fri Oct 22 07:35:29 1999 UTC revision 450, Fri Oct 22 17:10:09 1999 UTC
# Line 43  Line 43 
43                               Compile.newTraversal (fn _ => fn _ => (),                               Compile.newTraversal (fn _ => fn _ => (),
44                                                     store, g)                                                     store, g)
45                       in                       in
46                           case group gp of                           case Servers.withServers (fn () => group gp) of
47                               NONE => NONE                               NONE => NONE
48                             | SOME _ => SOME get                             | SOME _ => SOME get
49                       end                       end
# Line 172  Line 172 
172                               errcons = errcons }                               errcons = errcons }
173    
174          fun mk_main_compile arg = let          fun mk_main_compile arg = let
175    
176              val { rts, core, pervasive, primitives, binpaths } = arg              val { rts, core, pervasive, primitives, binpaths } = arg
177    
178              val ovldR = GenericVC.Control.overloadKW              val ovldR = GenericVC.Control.overloadKW
# Line 233  Line 234 
234                          { corenv = corenv }                          { corenv = corenv }
235              val stab =              val stab =
236                  if deliver then SOME true else NONE                  if deliver then SOME true else NONE
237    
238                (* We need to announce the project here because Parse.parse
239                 * may already invoke the compiler (because of "deliver"). *)
240                val _ = Servers.cmb dirbase
241          in          in
242              case Parse.parse NONE param stab maingspec of              case Parse.parse NONE param stab maingspec of
243                  NONE => NONE                  NONE => NONE
# Line 241  Line 246 
246                          fun store _ = ()                          fun store _ = ()
247                          val { group = recomp, ... } =                          val { group = recomp, ... } =
248                              Compile.newTraversal (fn _ => fn _ => (), store, g)                              Compile.newTraversal (fn _ => fn _ => (), store, g)
249                            val res =
250                                Servers.withServers (fn () => recomp gp)
251                      in                      in
252                          if isSome (recomp gp) then let                          if isSome res then let
253                              val rtspid = PS.toHex (#statpid (#ii rts))                              val rtspid = PS.toHex (#statpid (#ii rts))
254                              fun writeList s = let                              fun writeList s = let
255                                  fun add ((p, flag), l) = let                                  fun add ((p, flag), l) = let
# Line 293  Line 300 
300                          else false                          else false
301                      end                      end
302                  in                  in
303                      SOME ((g, gp), thunk, dirbase)                      SOME ((g, gp), thunk)
304                  end                  end
305          end handle Option => (Compile.reset (); NONE)          end handle Option => (Compile.reset (); NONE)
306                     (* to catch valOf failures in "rt" *)                     (* to catch valOf failures in "rt" *)
# Line 304  Line 311 
311      end      end
312    
313      fun compile deliver dbopt =      fun compile deliver dbopt =
         (Servers.disable ();            (* no parallel stuff during init *)  
314           case mk_compile deliver dbopt of           case mk_compile deliver dbopt of
315               NONE => false               NONE => false
316             | SOME (_, thunk, db) =>            | SOME (_, thunk) => thunk () before Servers.waitforall ()
                  (Servers.enable ();  
                   Servers.cmb db;  
                   thunk ()  
                   before Servers.waitforall ()))  
317    
318      local      local
319          fun slave dirbase =          fun slave dirbase =
320              case mk_compile false (SOME dirbase) of              case mk_compile false (SOME dirbase) of
321                  NONE => NONE                  NONE => NONE
322                | SOME ((g, gp), _, _) => let                | SOME ((g, gp), _) => let
323                      val trav = Compile.newSbnodeTraversal () gp                      val trav = Compile.newSbnodeTraversal () gp
324                      fun trav' sbn = isSome (trav sbn)                      fun trav' sbn = isSome (trav sbn)
325                  in                  in

Legend:
Removed from v.449  
changed lines
  Added in v.450

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