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/stable/stabilize.sml
ViewVC logotype

Diff of /sml/trunk/src/cm/stable/stabilize.sml

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

revision 360, Tue Jun 29 09:21:02 1999 UTC revision 380, Fri Jul 9 05:22:18 1999 UTC
# Line 32  Line 32 
32  end  end
33    
34  functor StabilizeFn (val bn2statenv : statenvgetter  functor StabilizeFn (val bn2statenv : statenvgetter
35                       val getPid : SmlInfo.info -> pid option                       val transfer_state : SmlInfo.info * BinInfo.info -> unit
                      val warmup : BinInfo.info * pid option -> unit  
36                       val recomp : recomp) :> STABILIZE = struct                       val recomp : recomp) :> STABILIZE = struct
37    
38      datatype pitem =      datatype pitem =
# Line 136  Line 135 
135              fun oneB i (sy, ((_, DG.SB_BNODE (DG.BNODE n)), _), m) =              fun oneB i (sy, ((_, DG.SB_BNODE (DG.BNODE n)), _), m) =
136                  StableMap.insert (m, #bininfo n, (i, sy))                  StableMap.insert (m, #bininfo n, (i, sy))
137                | oneB i (_, _, m) = m                | oneB i (_, _, m) = m
138              fun oneSL ((_, g as GG.GROUP { exports, ... }), (m, i)) =              fun oneSL ((g as GG.GROUP { exports, ... }), (m, i)) =
139                  (SymbolMap.foldli (oneB i) m exports, i + 1)                  (SymbolMap.foldli (oneB i) m exports, i + 1)
140              val inverseMap = #1 (foldl oneSL (StableMap.empty, 0) sublibs)              val inverseMap = #1 (foldl oneSL (StableMap.empty, 0) sublibs)
141    
# Line 279  Line 278 
278                      "b" :: w_int n (w_symbol sy k) m                      "b" :: w_int n (w_symbol sy k) m
279                  end                  end
280    
281              fun w_pid p = w_string (Byte.bytesToString (Pid.toBytes p))              fun w_bool true k m = "t" :: k m
282                  | w_bool false k m = "f" :: k m
283    
284              fun w_sn_raw (DG.SNODE n) k =              fun w_sn_raw (DG.SNODE n) k =
285                  w_option w_pid (getPid (#smlinfo n))                  w_si (#smlinfo n)
                          (w_si (#smlinfo n)  
286                                 (w_list w_sn (#localimports n)                                 (w_list w_sn (#localimports n)
287                                         (w_list w_fsbn (#globalimports n) k)))                                    (w_list w_fsbn (#globalimports n) k))
288    
289              and w_sn n = w_share w_sn_raw PSN n              and w_sn n = w_share w_sn_raw PSN n
290    
# Line 298  Line 297 
297    
298              fun w_exports e = w_list w_impexp (SymbolMap.listItemsi e)              fun w_exports e = w_list w_impexp (SymbolMap.listItemsi e)
299    
             fun w_bool true k m = "t" :: k m  
               | w_bool false k m = "f" :: k m  
   
300              fun w_privileges p = w_list w_string (StringSet.listItems p)              fun w_privileges p = w_list w_string (StringSet.listItems p)
301    
302              fun pickle_group () = let              fun pickle_group () = let
303                  fun w_sg (p, _) = w_abspath p                  fun w_sg (GG.GROUP { grouppath, ... }) = w_abspath grouppath
304                  fun k0 m = []                  fun k0 m = []
305                  val m0 = (0, Map.empty)                  val m0 = (0, Map.empty)
306              in              in
# Line 319  Line 315 
315              val sz = size pickle              val sz = size pickle
316              val offset_adjustment = sz + 4              val offset_adjustment = sz + 4
317    
318              fun mkStableGroup sname = let              fun mkStableGroup mksname = let
319                  val m = ref SmlInfoMap.empty                  val m = ref SmlInfoMap.empty
320                  fun sn (DG.SNODE (n as { smlinfo, ... })) =                  fun sn (DG.SNODE (n as { smlinfo, ... })) =
321                      case SmlInfoMap.find (!m, smlinfo) of                      case SmlInfoMap.find (!m, smlinfo) of
# Line 337  Line 333 
333                              val locs = SmlInfo.errorLocation gp smlinfo                              val locs = SmlInfo.errorLocation gp smlinfo
334                              val error = EM.errorNoSource grpSrcInfo locs                              val error = EM.errorNoSource grpSrcInfo locs
335                              val i = BinInfo.new { group = grouppath,                              val i = BinInfo.new { group = grouppath,
336                                                    stablename = sname,                                                    mkStablename = mksname,
337                                                    spec = spec,                                                    spec = spec,
338                                                    offset = offset,                                                    offset = offset,
339                                                    share = share,                                                    share = share,
# Line 346  Line 342 
342                                                 localimports = li,                                                 localimports = li,
343                                                 globalimports = gi }                                                 globalimports = gi }
344                          in                          in
345                                transfer_state (smlinfo, i);
346                              m := SmlInfoMap.insert (!m, smlinfo, n);                              m := SmlInfoMap.insert (!m, smlinfo, n);
347                              n                              n
348                          end                          end
# Line 376  Line 373 
373              val memberlist = rev (!members)              val memberlist = rev (!members)
374    
375              val gpath = #grouppath grec              val gpath = #grouppath grec
376              val sname = FilenamePolicy.mkStableName policy gpath              fun mksname () = FilenamePolicy.mkStableName policy gpath
377              fun work outs =              fun work outs =
378                  (Say.vsay ["[stabilizing ", SrcPath.descr gpath, "]\n"];                  (Say.vsay ["[stabilizing ", SrcPath.descr gpath, "]\n"];
379                   writeInt32 (outs, sz);                   writeInt32 (outs, sz);
380                   BinIO.output (outs, Byte.stringToBytes pickle);                   BinIO.output (outs, Byte.stringToBytes pickle);
381                   app (cpb outs) memberlist;                   app (cpb outs) memberlist;
382                   mkStableGroup sname)                   mkStableGroup mksname)
383          in          in
384              SOME (SafeIO.perform { openIt = fn () => AutoDir.openBinOut sname,              SOME (SafeIO.perform { openIt = AutoDir.openBinOut o mksname,
385                                     closeIt = BinIO.closeOut,                                     closeIt = BinIO.closeOut,
386                                     work = work,                                     work = work,
387                                     cleanup = fn () =>                                     cleanup = fn () =>
388                                      (OS.FileSys.remove sname handle _ => ()) })                                      (OS.FileSys.remove (mksname ())
389                                         handle _ => ()) })
390              handle exn => NONE              handle exn => NONE
391          end          end
392      in      in
# Line 399  Line 397 
397                  if not (recomp gp g) then                  if not (recomp gp g) then
398                      (anyerrors := true; NONE)                      (anyerrors := true; NONE)
399                  else let                  else let
400                      fun notStable (_, GG.GROUP { kind, ... }) =                      fun notStable (GG.GROUP { kind, ... }) =
401                          case kind of GG.STABLELIB _ => false | _ => true                          case kind of GG.STABLELIB _ => false | _ => true
402                  in                  in
403                      case List.filter notStable (#sublibs grec) of                      case List.filter notStable (#sublibs grec) of
# Line 408  Line 406 
406                              val grammar = case l of [_] => " is" | _ => "s are"                              val grammar = case l of [_] => " is" | _ => "s are"
407                              fun ppb pps = let                              fun ppb pps = let
408                                  fun loop [] = ()                                  fun loop [] = ()
409                                    | loop ((p, GG.GROUP { grouppath, ... })                                    | loop (GG.GROUP { grouppath, ... } :: t) =
                                           :: t) =  
410                                      (PP.add_string pps                                      (PP.add_string pps
411                                          (SrcPath.descr grouppath);                                          (SrcPath.descr grouppath);
                                      PP.add_string pps " (";  
                                      PP.add_string pps (SrcPath.descr p);  
                                      PP.add_string pps ")";  
412                                       PP.add_newline pps;                                       PP.add_newline pps;
413                                       loop t)                                       loop t)
414                              in                              in
# Line 447  Line 441 
441          val grpSrcInfo = (errcons, anyerrors)          val grpSrcInfo = (errcons, anyerrors)
442          val gdescr = SrcPath.descr group          val gdescr = SrcPath.descr group
443          fun error l = EM.errorNoFile (errcons, anyerrors) SM.nullRegion          fun error l = EM.errorNoFile (errcons, anyerrors) SM.nullRegion
444              EM.COMPLAIN (concat (gdescr :: ": " :: l)) EM.nullErrorBody              EM.COMPLAIN (concat ("(stable) " :: gdescr :: ": " :: l))
445                EM.nullErrorBody
446    
447          exception Format          exception Format
448    
449          val pcmode = #pcmode (#param gp)          val pcmode = #pcmode (#param gp)
450          val policy = #fnpolicy (#param gp)          val policy = #fnpolicy (#param gp)
451          val primconf = #primconf (#param gp)          val primconf = #primconf (#param gp)
452          val sname = FilenamePolicy.mkStableName policy group          fun mksname () = FilenamePolicy.mkStableName policy group
         val _ = Say.vsay ["[checking stable ", gdescr, "]\n"]  
453    
454          fun work s = let          fun work s = let
455    
# Line 555  Line 549 
549              end              end
550    
551              fun r_abspath () =              fun r_abspath () =
552                  case SrcPath.unpickle pcmode (r_list r_string (), group) of                  SrcPath.unpickle pcmode (r_list r_string (), group)
553                      SOME p => p                  handle SrcPath.Format => raise Format
554                    | NONE => raise Format                       | SrcPath.BadAnchor a =>
555                           (error ["configuration anchor \"", a, "\" undefined"];
556                            raise Format)
557    
558    
559              val r_symbol = let              val r_symbol = let
560                  fun r_symbol_raw () = let                  fun r_symbol_raw () = let
# Line 609  Line 606 
606                  val error = EM.errorNoSource grpSrcInfo locs                  val error = EM.errorNoSource grpSrcInfo locs
607              in              in
608                  BinInfo.new { group = group,                  BinInfo.new { group = group,
609                                stablename = sname,                                mkStablename = mksname,
610                                error = error,                                error = error,
611                                spec = spec,                                spec = spec,
612                                offset = offset,                                offset = offset,
613                                share = share }                                share = share }
614              end              end
615    
616              fun r_sg () = let              fun r_sg () = getGroup' (r_abspath ())
                 val p = r_abspath ()  
             in  
                 (p, getGroup' p)  
             end  
617    
618              val sublibs = r_list r_sg ()              val sublibs = r_list r_sg ()
619    
# Line 630  Line 623 
623                    | #"b" => let                    | #"b" => let
624                          val n = r_int ()                          val n = r_int ()
625                          val sy = r_symbol ()                          val sy = r_symbol ()
626                          val (_, GG.GROUP { exports = slexp, ... }) =                          val GG.GROUP { exports = slexp, ... } =
627                              List.nth (sublibs, n) handle _ => raise Format                              List.nth (sublibs, n) handle _ => raise Format
628                      in                      in
629                          case SymbolMap.find (slexp, sy) of                          case SymbolMap.find (slexp, sy) of
# Line 639  Line 632 
632                      end                      end
633                    | _ => raise Format                    | _ => raise Format
634    
             fun r_pid () = Pid.fromBytes (Byte.stringToBytes (r_string ()))  
   
635              (* this is the place where what used to be an              (* this is the place where what used to be an
636               * SNODE changes to a BNODE! *)               * SNODE changes to a BNODE! *)
637              fun r_sn_raw () = let              fun r_sn_raw () =
638                  val popt = r_option r_pid ()                  DG.BNODE { bininfo = r_si (),
                 val i = r_si ()  
             in  
                 warmup (i, popt);  
                 DG.BNODE { bininfo = i,  
639                             localimports = r_list r_sn (),                             localimports = r_list r_sn (),
640                             globalimports = r_list r_fsbn () }                             globalimports = r_list r_fsbn () }
             end  
641    
642              and r_sn () =              and r_sn () =
643                  r_share r_sn_raw UBN (fn (UBN n) => n | _ => raise Format) ()                  r_share r_sn_raw UBN (fn (UBN n) => n | _ => raise Format) ()
# Line 693  Line 679 
679                         sublibs = sublibs }                         sublibs = sublibs }
680          end          end
681      in      in
682          SOME (SafeIO.perform { openIt = fn () => BinIO.openIn sname,          SOME (SafeIO.perform { openIt = BinIO.openIn o mksname,
683                                 closeIt = BinIO.closeIn,                                 closeIt = BinIO.closeIn,
684                                 work = work,                                 work = work,
685                                 cleanup = fn () => () })                                 cleanup = fn () => () })

Legend:
Removed from v.360  
changed lines
  Added in v.380

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