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 362, Thu Jul 1 09:39:48 1999 UTC
# Line 33  Line 33 
33    
34  functor StabilizeFn (val bn2statenv : statenvgetter  functor StabilizeFn (val bn2statenv : statenvgetter
35                       val getPid : SmlInfo.info -> pid option                       val getPid : SmlInfo.info -> pid option
                      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 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    
             fun w_pid p = w_string (Byte.bytesToString (Pid.toBytes p))  
   
281              fun w_sn_raw (DG.SNODE n) k =              fun w_sn_raw (DG.SNODE n) k =
282                  w_option w_pid (getPid (#smlinfo n))                  w_si (#smlinfo n)
                          (w_si (#smlinfo n)  
283                                 (w_list w_sn (#localimports n)                                 (w_list w_sn (#localimports n)
284                                         (w_list w_fsbn (#globalimports n) k)))                                    (w_list w_fsbn (#globalimports n) k))
285    
286              and w_sn n = w_share w_sn_raw PSN n              and w_sn n = w_share w_sn_raw PSN n
287    
# 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 376  Line 372 
372              val memberlist = rev (!members)              val memberlist = rev (!members)
373    
374              val gpath = #grouppath grec              val gpath = #grouppath grec
375              val sname = FilenamePolicy.mkStableName policy gpath              fun mksname () = FilenamePolicy.mkStableName policy gpath
376              fun work outs =              fun work outs =
377                  (Say.vsay ["[stabilizing ", SrcPath.descr gpath, "]\n"];                  (Say.vsay ["[stabilizing ", SrcPath.descr gpath, "]\n"];
378                   writeInt32 (outs, sz);                   writeInt32 (outs, sz);
379                   BinIO.output (outs, Byte.stringToBytes pickle);                   BinIO.output (outs, Byte.stringToBytes pickle);
380                   app (cpb outs) memberlist;                   app (cpb outs) memberlist;
381                   mkStableGroup sname)                   mkStableGroup mksname)
382          in          in
383              SOME (SafeIO.perform { openIt = fn () => AutoDir.openBinOut sname,              SOME (SafeIO.perform { openIt = AutoDir.openBinOut o mksname,
384                                     closeIt = BinIO.closeOut,                                     closeIt = BinIO.closeOut,
385                                     work = work,                                     work = work,
386                                     cleanup = fn () =>                                     cleanup = fn () =>
387                                      (OS.FileSys.remove sname handle _ => ()) })                                      (OS.FileSys.remove (mksname ())
388                                         handle _ => ()) })
389              handle exn => NONE              handle exn => NONE
390          end          end
391      in      in
# Line 454  Line 451 
451          val pcmode = #pcmode (#param gp)          val pcmode = #pcmode (#param gp)
452          val policy = #fnpolicy (#param gp)          val policy = #fnpolicy (#param gp)
453          val primconf = #primconf (#param gp)          val primconf = #primconf (#param gp)
454          val sname = FilenamePolicy.mkStableName policy group          fun mksname () = FilenamePolicy.mkStableName policy group
455          val _ = Say.vsay ["[checking stable ", gdescr, "]\n"]          val _ = Say.vsay ["[checking stable ", gdescr, "]\n"]
456    
457          fun work s = let          fun work s = 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,
# Line 639  Line 636 
636                      end                      end
637                    | _ => raise Format                    | _ => raise Format
638    
             fun r_pid () = Pid.fromBytes (Byte.stringToBytes (r_string ()))  
   
639              (* this is the place where what used to be an              (* this is the place where what used to be an
640               * SNODE changes to a BNODE! *)               * SNODE changes to a BNODE! *)
641              fun r_sn_raw () = let              fun r_sn_raw () = let
                 val popt = r_option r_pid ()  
642                  val i = r_si ()                  val i = r_si ()
643              in              in
                 warmup (i, popt);  
644                  DG.BNODE { bininfo = i,                  DG.BNODE { bininfo = i,
645                             localimports = r_list r_sn (),                             localimports = r_list r_sn (),
646                             globalimports = r_list r_fsbn () }                             globalimports = r_list r_fsbn () }
# Line 693  Line 686 
686                         sublibs = sublibs }                         sublibs = sublibs }
687          end          end
688      in      in
689          SOME (SafeIO.perform { openIt = fn () => BinIO.openIn sname,          SOME (SafeIO.perform { openIt = BinIO.openIn o mksname,
690                                 closeIt = BinIO.closeIn,                                 closeIt = BinIO.closeIn,
691                                 work = work,                                 work = work,
692                                 cleanup = fn () => () })                                 cleanup = fn () => () })

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

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