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 311, Wed Jun 2 09:08:48 1999 UTC revision 329, Fri Jun 11 09:53:10 1999 UTC
# Line 15  Line 15 
15      structure E = GenericVC.Environment      structure E = GenericVC.Environment
16    
17      type statenvgetter = GP.info -> DG.bnode -> E.staticEnv      type statenvgetter = GP.info -> DG.bnode -> E.staticEnv
18      type recomp = GG.group * GP.info -> bool      type recomp = GP.info -> GG.group -> bool
19  in  in
20    
21  signature STABILIZE = sig  signature STABILIZE = sig
# Line 82  Line 82 
82    
83      fun stabilize gp { group = g as GG.GROUP grec, anyerrors } = let      fun stabilize gp { group = g as GG.GROUP grec, anyerrors } = let
84    
85            val primconf = #primconf (#param gp)
86            val policy = #fnpolicy (#param gp)
87    
88          fun doit granted = let          fun doit granted = let
89    
90                val _ =
91                    if StringSet.isEmpty granted then ()
92                    else
93                        Say.say ("$Stabilize: wrapping the following privileges:\n"
94                                 :: map (fn s => ("  " ^ s ^ "\n"))
95                                        (StringSet.listItems granted))
96    
97              val bname = AbsPath.name o SmlInfo.binpath              val bname = AbsPath.name o SmlInfo.binpath
98              val bsz = OS.FileSys.fileSize o bname              val bsz = OS.FileSys.fileSize o bname
99              fun cpb s i = let              fun cpb s i = let
# Line 213  Line 224 
224                                 (w_sharing (SmlInfo.share i) k)))                                 (w_sharing (SmlInfo.share i) k)))
225              end              end
226    
227              fun w_primitive p k m = String.str (Primitive.toIdent p) :: k m              fun w_primitive p k m =
228                    String.str (Primitive.toIdent primconf p) :: k m
229    
230              fun w_abspath_raw p k m = w_list w_string (AbsPath.pickle p) k m              fun w_abspath_raw p k m = w_list w_string (AbsPath.pickle p) k m
231    
# Line 260  Line 272 
272              val sz = size pickle              val sz = size pickle
273              val offset_adjustment = sz + 4              val offset_adjustment = sz + 4
274    
275              fun mkStableGroup () = let              fun mkStableGroup spath = let
276                  val m = ref SmlInfoMap.empty                  val m = ref SmlInfoMap.empty
277                  fun sn (DG.SNODE (n as { smlinfo, ... })) =                  fun sn (DG.SNODE (n as { smlinfo, ... })) =
278                      case SmlInfoMap.find (!m, smlinfo) of                      case SmlInfoMap.find (!m, smlinfo) of
# Line 276  Line 288 
288                              val locs = SmlInfo.errorLocation gp smlinfo                              val locs = SmlInfo.errorLocation gp smlinfo
289                              val error = EM.errorNoSource grpSrcInfo locs                              val error = EM.errorNoSource grpSrcInfo locs
290                              val i = BinInfo.new { group = grouppath,                              val i = BinInfo.new { group = grouppath,
291                                                      stablepath = spath,
292                                                    spec = spec,                                                    spec = spec,
293                                                    offset = offset,                                                    offset = offset,
294                                                    share = share,                                                    share = share,
# Line 314  Line 327 
327              end              end
328              val memberlist = rev (!members)              val memberlist = rev (!members)
329    
             val policy = #fnpolicy (#param gp)  
330              val gpath = #grouppath grec              val gpath = #grouppath grec
331              val spath = FilenamePolicy.mkStablePath policy gpath              val spath = FilenamePolicy.mkStablePath policy gpath
332              fun delete () = deleteFile (AbsPath.name spath)              fun delete () = deleteFile (AbsPath.name spath)
# Line 326  Line 338 
338                   app (cpb outs) memberlist;                   app (cpb outs) memberlist;
339                   app delb memberlist;                   app delb memberlist;
340                   BinIO.closeOut outs;                   BinIO.closeOut outs;
341                   SOME (mkStableGroup ()))                   SOME (mkStableGroup spath))
342          in          in
343              Interrupt.guarded try              Interrupt.guarded try
344              handle e as Interrupt.Interrupt => (BinIO.closeOut outs;              handle e as Interrupt.Interrupt => (BinIO.closeOut outs;
# Line 338  Line 350 
350          case #stableinfo grec of          case #stableinfo grec of
351              GG.STABLE _ => SOME g              GG.STABLE _ => SOME g
352            | GG.NONSTABLE granted =>            | GG.NONSTABLE granted =>
353                  if not (recomp (g, gp)) then                  if not (recomp gp g) then
354                      (anyerrors := true; NONE)                      (anyerrors := true; NONE)
355                  else let                  else let
356                      fun notStable (GG.GROUP { stableinfo, ... }) =                      fun notStable (GG.GROUP { stableinfo, ... }) =
# Line 389  Line 401 
401    
402          exception Format          exception Format
403    
404            val pcmode = #pcmode (#param gp)
405          val policy = #fnpolicy (#param gp)          val policy = #fnpolicy (#param gp)
406            val primconf = #primconf (#param gp)
407          val spath = FilenamePolicy.mkStablePath policy group          val spath = FilenamePolicy.mkStablePath policy group
408          val _ = Say.vsay ["[checking stable ", gname, "]\n"]          val _ = Say.vsay ["[checking stable ", gname, "]\n"]
409          val s = AbsPath.openBinIn spath          val s = AbsPath.openBinIn spath
# Line 489  Line 503 
503    
504          val r_abspath = let          val r_abspath = let
505              fun r_abspath_raw () =              fun r_abspath_raw () =
506                  case AbsPath.unpickle (r_list r_string ()) of                  case AbsPath.unpickle pcmode (r_list r_string ()) of
507                      SOME p => p                      SOME p => p
508                    | NONE => raise Format                    | NONE => raise Format
509              fun unUAP (UAP x) = x              fun unUAP (UAP x) = x
# Line 529  Line 543 
543          val r_filter = r_option r_ss          val r_filter = r_option r_ss
544    
545          fun r_primitive () =          fun r_primitive () =
546              case Primitive.fromIdent (rd ()) of              case Primitive.fromIdent primconf (rd ()) of
547                  NONE => raise Format                  NONE => raise Format
548                | SOME p => p                | SOME p => p
549    
# Line 548  Line 562 
562              val error = EM.errorNoSource grpSrcInfo locs              val error = EM.errorNoSource grpSrcInfo locs
563          in          in
564              BinInfo.new { group = group,              BinInfo.new { group = group,
565                              stablepath = spath,
566                            error = error,                            error = error,
567                            spec = spec,                            spec = spec,
568                            offset = offset,                            offset = offset,

Legend:
Removed from v.311  
changed lines
  Added in v.329

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