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 367, Sat Jul 3 04:59:01 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
36                       val warmup : BinInfo.info * pid option -> unit                       val transfer_state : SmlInfo.info * BinInfo.info -> unit
37                       val recomp : recomp) :> STABILIZE = struct                       val recomp : recomp) :> STABILIZE = struct
38    
39      datatype pitem =      datatype pitem =
# Line 279  Line 279 
279                      "b" :: w_int n (w_symbol sy k) m                      "b" :: w_int n (w_symbol sy k) m
280                  end                  end
281    
             fun w_pid p = w_string (Byte.bytesToString (Pid.toBytes p))  
   
282              fun w_sn_raw (DG.SNODE n) k =              fun w_sn_raw (DG.SNODE n) k =
283                  w_option w_pid (getPid (#smlinfo n))                  w_si (#smlinfo n)
                          (w_si (#smlinfo n)  
284                                 (w_list w_sn (#localimports n)                                 (w_list w_sn (#localimports n)
285                                         (w_list w_fsbn (#globalimports n) k)))                                    (w_list w_fsbn (#globalimports n) k))
286    
287              and w_sn n = w_share w_sn_raw PSN n              and w_sn n = w_share w_sn_raw PSN n
288    
# Line 319  Line 316 
316              val sz = size pickle              val sz = size pickle
317              val offset_adjustment = sz + 4              val offset_adjustment = sz + 4
318    
319              fun mkStableGroup sname = let              fun mkStableGroup mksname = let
320                  val m = ref SmlInfoMap.empty                  val m = ref SmlInfoMap.empty
321                  fun sn (DG.SNODE (n as { smlinfo, ... })) =                  fun sn (DG.SNODE (n as { smlinfo, ... })) =
322                      case SmlInfoMap.find (!m, smlinfo) of                      case SmlInfoMap.find (!m, smlinfo) of
# Line 337  Line 334 
334                              val locs = SmlInfo.errorLocation gp smlinfo                              val locs = SmlInfo.errorLocation gp smlinfo
335                              val error = EM.errorNoSource grpSrcInfo locs                              val error = EM.errorNoSource grpSrcInfo locs
336                              val i = BinInfo.new { group = grouppath,                              val i = BinInfo.new { group = grouppath,
337                                                    stablename = sname,                                                    mkStablename = mksname,
338                                                    spec = spec,                                                    spec = spec,
339                                                    offset = offset,                                                    offset = offset,
340                                                    share = share,                                                    share = share,
# Line 346  Line 343 
343                                                 localimports = li,                                                 localimports = li,
344                                                 globalimports = gi }                                                 globalimports = gi }
345                          in                          in
346                                transfer_state (smlinfo, i);
347                              m := SmlInfoMap.insert (!m, smlinfo, n);                              m := SmlInfoMap.insert (!m, smlinfo, n);
348                              n                              n
349                          end                          end
# Line 376  Line 374 
374              val memberlist = rev (!members)              val memberlist = rev (!members)
375    
376              val gpath = #grouppath grec              val gpath = #grouppath grec
377              val sname = FilenamePolicy.mkStableName policy gpath              fun mksname () = FilenamePolicy.mkStableName policy gpath
378              fun work outs =              fun work outs =
379                  (Say.vsay ["[stabilizing ", SrcPath.descr gpath, "]\n"];                  (Say.vsay ["[stabilizing ", SrcPath.descr gpath, "]\n"];
380                   writeInt32 (outs, sz);                   writeInt32 (outs, sz);
381                   BinIO.output (outs, Byte.stringToBytes pickle);                   BinIO.output (outs, Byte.stringToBytes pickle);
382                   app (cpb outs) memberlist;                   app (cpb outs) memberlist;
383                   mkStableGroup sname)                   mkStableGroup mksname)
384          in          in
385              SOME (SafeIO.perform { openIt = fn () => AutoDir.openBinOut sname,              SOME (SafeIO.perform { openIt = AutoDir.openBinOut o mksname,
386                                     closeIt = BinIO.closeOut,                                     closeIt = BinIO.closeOut,
387                                     work = work,                                     work = work,
388                                     cleanup = fn () =>                                     cleanup = fn () =>
389                                      (OS.FileSys.remove sname handle _ => ()) })                                      (OS.FileSys.remove (mksname ())
390                                         handle _ => ()) })
391              handle exn => NONE              handle exn => NONE
392          end          end
393      in      in
# Line 447  Line 446 
446          val grpSrcInfo = (errcons, anyerrors)          val grpSrcInfo = (errcons, anyerrors)
447          val gdescr = SrcPath.descr group          val gdescr = SrcPath.descr group
448          fun error l = EM.errorNoFile (errcons, anyerrors) SM.nullRegion          fun error l = EM.errorNoFile (errcons, anyerrors) SM.nullRegion
449              EM.COMPLAIN (concat (gdescr :: ": " :: l)) EM.nullErrorBody              EM.COMPLAIN (concat ("(stable) " :: gdescr :: ": " :: l))
450                EM.nullErrorBody
451    
452          exception Format          exception Format
453    
454          val pcmode = #pcmode (#param gp)          val pcmode = #pcmode (#param gp)
455          val policy = #fnpolicy (#param gp)          val policy = #fnpolicy (#param gp)
456          val primconf = #primconf (#param gp)          val primconf = #primconf (#param gp)
457          val sname = FilenamePolicy.mkStableName policy group          fun mksname () = FilenamePolicy.mkStableName policy group
         val _ = Say.vsay ["[checking stable ", gdescr, "]\n"]  
458    
459          fun work s = let          fun work s = let
460    
# Line 555  Line 554 
554              end              end
555    
556              fun r_abspath () =              fun r_abspath () =
557                  case SrcPath.unpickle pcmode (r_list r_string (), group) of                  SrcPath.unpickle pcmode (r_list r_string (), group)
558                      SOME p => p                  handle SrcPath.Format => raise Format
559                    | NONE => raise Format                       | SrcPath.BadAnchor a =>
560                           (error ["configuration anchor \"", a, "\" undefined"];
561                            raise Format)
562    
563    
564              val r_symbol = let              val r_symbol = let
565                  fun r_symbol_raw () = let                  fun r_symbol_raw () = let
# Line 609  Line 611 
611                  val error = EM.errorNoSource grpSrcInfo locs                  val error = EM.errorNoSource grpSrcInfo locs
612              in              in
613                  BinInfo.new { group = group,                  BinInfo.new { group = group,
614                                stablename = sname,                                mkStablename = mksname,
615                                error = error,                                error = error,
616                                spec = spec,                                spec = spec,
617                                offset = offset,                                offset = offset,
# Line 639  Line 641 
641                      end                      end
642                    | _ => raise Format                    | _ => raise Format
643    
             fun r_pid () = Pid.fromBytes (Byte.stringToBytes (r_string ()))  
   
644              (* this is the place where what used to be an              (* this is the place where what used to be an
645               * SNODE changes to a BNODE! *)               * SNODE changes to a BNODE! *)
646              fun r_sn_raw () = let              fun r_sn_raw () = let
                 val popt = r_option r_pid ()  
647                  val i = r_si ()                  val i = r_si ()
648              in              in
                 warmup (i, popt);  
649                  DG.BNODE { bininfo = i,                  DG.BNODE { bininfo = i,
650                             localimports = r_list r_sn (),                             localimports = r_list r_sn (),
651                             globalimports = r_list r_fsbn () }                             globalimports = r_list r_fsbn () }
# Line 693  Line 691 
691                         sublibs = sublibs }                         sublibs = sublibs }
692          end          end
693      in      in
694          SOME (SafeIO.perform { openIt = fn () => BinIO.openIn sname,          SOME (SafeIO.perform { openIt = BinIO.openIn o mksname,
695                                 closeIt = BinIO.closeIn,                                 closeIt = BinIO.closeIn,
696                                 work = work,                                 work = work,
697                                 cleanup = fn () => () })                                 cleanup = fn () => () })

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

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