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 370, Mon Jul 5 08:59:13 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 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 = let
285                    val i = #smlinfo n
286                    val li = #localimports n
287                    val gi = #globalimports n
288                in
289                    Say.say ["+++ w_sn_raw: ", SmlInfo.descr i, "\n"];
290                    app (fn (DG.SNODE n, ref r) =>
291                          (Say.say ["     ", if r then "+" else "-",
292                                    SmlInfo.descr (#smlinfo n), "\n"])) li;
293                    app (fn ((_, sbn), ref r) =>
294                          (Say.say ["      ", if r then "+" else "-",
295                                    DG.describeSBN sbn, "\n"])) gi;
296                    w_si i (w_list w_sloci li (w_list w_sglobi gi k))
297                end
298    
299              fun w_sn_raw (DG.SNODE n) k =              and w_sloci (n, ref r) k m = w_sn n (w_bool r k) m
300                  w_option w_pid (getPid (#smlinfo n))              and w_sglobi (n, ref r) k m = w_fsbn n (w_bool r k) m
                          (w_si (#smlinfo n)  
                                (w_list w_sn (#localimports n)  
                                        (w_list w_fsbn (#globalimports n) k)))  
301    
302              and w_sn n = w_share w_sn_raw PSN n              and w_sn n = w_share w_sn_raw PSN n
303    
# Line 298  Line 310 
310    
311              fun w_exports e = w_list w_impexp (SymbolMap.listItemsi e)              fun w_exports e = w_list w_impexp (SymbolMap.listItemsi e)
312    
             fun w_bool true k m = "t" :: k m  
               | w_bool false k m = "f" :: k m  
   
313              fun w_privileges p = w_list w_string (StringSet.listItems p)              fun w_privileges p = w_list w_string (StringSet.listItems p)
314    
315              fun pickle_group () = let              fun pickle_group () = let
# Line 319  Line 328 
328              val sz = size pickle              val sz = size pickle
329              val offset_adjustment = sz + 4              val offset_adjustment = sz + 4
330    
331              fun mkStableGroup sname = let              fun mkStableGroup mksname = let
332                  val m = ref SmlInfoMap.empty                  val m = ref SmlInfoMap.empty
333                  fun sn (DG.SNODE (n as { smlinfo, ... })) =                  fun sn (DG.SNODE (n as { smlinfo, ... })) =
334                      case SmlInfoMap.find (!m, smlinfo) of                      case SmlInfoMap.find (!m, smlinfo) of
335                          SOME n => n                          SOME n => n
336                        | NONE => let                        | NONE => let
337                              val li = map sn (#localimports n)                              val li = map sloci (#localimports n)
338                              val gi = map fsbn (#globalimports n)                              val gi = map sglobi (#globalimports n)
339                              val sourcepath = SmlInfo.sourcepath smlinfo                              val sourcepath = SmlInfo.sourcepath smlinfo
340                              (* FIXME: see the comment near the other                              (* FIXME: see the comment near the other
341                               * occurence of SrcPath.spec... *)                               * occurence of SrcPath.spec... *)
# Line 337  Line 346 
346                              val locs = SmlInfo.errorLocation gp smlinfo                              val locs = SmlInfo.errorLocation gp smlinfo
347                              val error = EM.errorNoSource grpSrcInfo locs                              val error = EM.errorNoSource grpSrcInfo locs
348                              val i = BinInfo.new { group = grouppath,                              val i = BinInfo.new { group = grouppath,
349                                                    stablename = sname,                                                    mkStablename = mksname,
350                                                    spec = spec,                                                    spec = spec,
351                                                    offset = offset,                                                    offset = offset,
352                                                    share = share,                                                    share = share,
# Line 346  Line 355 
355                                                 localimports = li,                                                 localimports = li,
356                                                 globalimports = gi }                                                 globalimports = gi }
357                          in                          in
358                                transfer_state (smlinfo, i);
359                              m := SmlInfoMap.insert (!m, smlinfo, n);                              m := SmlInfoMap.insert (!m, smlinfo, n);
360                              n                              n
361                          end                          end
362    
363                    and sloci (n, ref r) = (sn n, r)
364                    and sglobi (n, ref r) = (fsbn n, r)
365    
366                  and sbn (DG.SB_SNODE n) = sn n                  and sbn (DG.SB_SNODE n) = sn n
367                    | sbn (DG.SB_BNODE n) = n                    | sbn (DG.SB_BNODE n) = n
368    
# Line 376  Line 389 
389              val memberlist = rev (!members)              val memberlist = rev (!members)
390    
391              val gpath = #grouppath grec              val gpath = #grouppath grec
392              val sname = FilenamePolicy.mkStableName policy gpath              fun mksname () = FilenamePolicy.mkStableName policy gpath
393              fun work outs =              fun work outs =
394                  (Say.vsay ["[stabilizing ", SrcPath.descr gpath, "]\n"];                  (Say.vsay ["[stabilizing ", SrcPath.descr gpath, "]\n"];
395                   writeInt32 (outs, sz);                   writeInt32 (outs, sz);
396                   BinIO.output (outs, Byte.stringToBytes pickle);                   BinIO.output (outs, Byte.stringToBytes pickle);
397                   app (cpb outs) memberlist;                   app (cpb outs) memberlist;
398                   mkStableGroup sname)                   mkStableGroup mksname)
399          in          in
400              SOME (SafeIO.perform { openIt = fn () => AutoDir.openBinOut sname,              SOME (SafeIO.perform { openIt = AutoDir.openBinOut o mksname,
401                                     closeIt = BinIO.closeOut,                                     closeIt = BinIO.closeOut,
402                                     work = work,                                     work = work,
403                                     cleanup = fn () =>                                     cleanup = fn () =>
404                                      (OS.FileSys.remove sname handle _ => ()) })                                      (OS.FileSys.remove (mksname ())
405                                         handle _ => ()) })
406              handle exn => NONE              handle exn => NONE
407          end          end
408      in      in
# Line 447  Line 461 
461          val grpSrcInfo = (errcons, anyerrors)          val grpSrcInfo = (errcons, anyerrors)
462          val gdescr = SrcPath.descr group          val gdescr = SrcPath.descr group
463          fun error l = EM.errorNoFile (errcons, anyerrors) SM.nullRegion          fun error l = EM.errorNoFile (errcons, anyerrors) SM.nullRegion
464              EM.COMPLAIN (concat (gdescr :: ": " :: l)) EM.nullErrorBody              EM.COMPLAIN (concat ("(stable) " :: gdescr :: ": " :: l))
465                EM.nullErrorBody
466    
467          exception Format          exception Format
468    
469          val pcmode = #pcmode (#param gp)          val pcmode = #pcmode (#param gp)
470          val policy = #fnpolicy (#param gp)          val policy = #fnpolicy (#param gp)
471          val primconf = #primconf (#param gp)          val primconf = #primconf (#param gp)
472          val sname = FilenamePolicy.mkStableName policy group          fun mksname () = FilenamePolicy.mkStableName policy group
         val _ = Say.vsay ["[checking stable ", gdescr, "]\n"]  
473    
474          fun work s = let          fun work s = let
475    
# Line 555  Line 569 
569              end              end
570    
571              fun r_abspath () =              fun r_abspath () =
572                  case SrcPath.unpickle pcmode (r_list r_string (), group) of                  SrcPath.unpickle pcmode (r_list r_string (), group)
573                      SOME p => p                  handle SrcPath.Format => raise Format
574                    | NONE => raise Format                       | SrcPath.BadAnchor a =>
575                           (error ["configuration anchor \"", a, "\" undefined"];
576                            raise Format)
577    
578    
579              val r_symbol = let              val r_symbol = let
580                  fun r_symbol_raw () = let                  fun r_symbol_raw () = let
# Line 609  Line 626 
626                  val error = EM.errorNoSource grpSrcInfo locs                  val error = EM.errorNoSource grpSrcInfo locs
627              in              in
628                  BinInfo.new { group = group,                  BinInfo.new { group = group,
629                                stablename = sname,                                mkStablename = mksname,
630                                error = error,                                error = error,
631                                spec = spec,                                spec = spec,
632                                offset = offset,                                offset = offset,
# Line 639  Line 656 
656                      end                      end
657                    | _ => raise Format                    | _ => raise Format
658    
             fun r_pid () = Pid.fromBytes (Byte.stringToBytes (r_string ()))  
   
659              (* this is the place where what used to be an              (* this is the place where what used to be an
660               * SNODE changes to a BNODE! *)               * SNODE changes to a BNODE! *)
661              fun r_sn_raw () = let              fun r_sn_raw () =
662                  val popt = r_option r_pid ()                  DG.BNODE { bininfo = r_si (),
663                  val i = r_si ()                             localimports = r_list r_sloci (),
664              in                             globalimports = r_list r_sglobi () }
665                  warmup (i, popt);  
666                  DG.BNODE { bininfo = i,              and r_sloci () = (r_sn (), r_bool ())
667                             localimports = r_list r_sn (),              and r_sglobi () = (r_fsbn (), r_bool ())
                            globalimports = r_list r_fsbn () }  
             end  
668    
669              and r_sn () =              and r_sn () =
670                  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 706 
706                         sublibs = sublibs }                         sublibs = sublibs }
707          end          end
708      in      in
709          SOME (SafeIO.perform { openIt = fn () => BinIO.openIn sname,          SOME (SafeIO.perform { openIt = BinIO.openIn o mksname,
710                                 closeIt = BinIO.closeIn,                                 closeIt = BinIO.closeIn,
711                                 work = work,                                 work = work,
712                                 cleanup = fn () => () })                                 cleanup = fn () => () })

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

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