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 399, Thu Aug 26 09:55:09 1999 UTC revision 403, Tue Aug 31 07:44:29 1999 UTC
# Line 17  Line 17 
17      structure P = PickMod      structure P = PickMod
18      structure UP = UnpickMod      structure UP = UnpickMod
19      structure E = GenericVC.Environment      structure E = GenericVC.Environment
   
     type recomp = GP.info -> GG.group -> bool  
     type pid = Pid.persstamp  
20  in  in
21    
22  signature STABILIZE = sig  signature STABILIZE = sig
# Line 33  Line 30 
30          GP.info -> { group: GG.group, anyerrors: bool ref } -> GG.group option          GP.info -> { group: GG.group, anyerrors: bool ref } -> GG.group option
31  end  end
32    
33  functor StabilizeFn (val writeBFC : BinIO.outstream -> SmlInfo.info -> unit  functor StabilizeFn (val destroy_state : GP.info -> SmlInfo.info -> unit
34                       val sizeBFC : SmlInfo.info -> int                       structure MachDepVC : MACHDEP_VC
35                       val getII :  SmlInfo.info -> IInfo.info                       val recomp : GP.info -> GG.group ->
36                       val destroy_state : SmlInfo.info -> unit                           (SmlInfo.info -> MachDepVC.Binfile.bfContent) option
37                       val recomp : recomp) :> STABILIZE = struct                       val getII : SmlInfo.info -> IInfo.info) :> STABILIZE =
38    struct
39    
40        structure BF = MachDepVC.Binfile
41    
42      structure SSMap = BinaryMapFn      structure SSMap = BinaryMapFn
43          (struct          (struct
# Line 88  Line 88 
88    
89          val grouppath = #grouppath grec          val grouppath = #grouppath grec
90    
91          fun doit wrapped = let          fun doit (wrapped, getBFC) = let
92    
93                fun writeBFC s i = BF.write { stream = s,
94                                              content = getBFC i,
95                                              nopickle = true }
96                fun sizeBFC i = BF.size { content = getBFC i, nopickle = true }
97    
98                val _ =
99                    Say.vsay ["[stabilizing ", SrcPath.descr grouppath, "]\n"]
100    
101              val _ =              val _ =
102                  if StringSet.isEmpty wrapped then ()                  if StringSet.isEmpty wrapped then ()
# Line 227  Line 235 
235              (* make the picklers for static and symbolic environments;              (* make the picklers for static and symbolic environments;
236               * lift them so we can use them here... *)               * lift them so we can use them here... *)
237              val envContext = mkContext ()              val envContext = mkContext ()
238    
239              val env_orig = P.envPickler envContext              val env_orig = P.envPickler envContext
240              val env = PU.lift_pickler lifter env_orig              val env = PU.lift_pickler lifter env_orig
241              val symenv_orig = P.symenvPickler              val symenv_orig = P.symenvPickler
# Line 365  Line 374 
374    
375              val dg_pickle =              val dg_pickle =
376                  Byte.stringToBytes (PU.pickle emptyMap (group ()))                  Byte.stringToBytes (PU.pickle emptyMap (group ()))
377    
378              val dg_sz = Word8Vector.length dg_pickle              val dg_sz = Word8Vector.length dg_pickle
379    
380              val offset_adjustment = dg_sz + 4              val offset_adjustment = dg_sz + 4
# Line 396  Line 406 
406                                                 localimports = li,                                                 localimports = li,
407                                                 globalimports = gi }                                                 globalimports = gi }
408                          in                          in
409                              destroy_state smlinfo;                              destroy_state gp smlinfo;
410                              m := SmlInfoMap.insert (!m, smlinfo, n);                              m := SmlInfoMap.insert (!m, smlinfo, n);
411                              n                              n
412                          end                          end
# Line 429  Line 439 
439              end              end
440              val memberlist = rev (!members)              val memberlist = rev (!members)
441    
442              val gpath = #grouppath grec              fun mksname () = FilenamePolicy.mkStableName policy grouppath
             fun mksname () = FilenamePolicy.mkStableName policy gpath  
443              fun work outs =              fun work outs =
444                  (Say.vsay ["[stabilizing ", SrcPath.descr gpath, "]\n"];                  (writeInt32 (outs, dg_sz);
                  writeInt32 (outs, dg_sz);  
445                   BinIO.output (outs, dg_pickle);                   BinIO.output (outs, dg_pickle);
446                   app (writeBFC outs) memberlist;                   app (writeBFC outs) memberlist;
447                   mkStableGroup mksname)                   mkStableGroup mksname)
# Line 451  Line 459 
459              GG.STABLELIB => SOME g              GG.STABLELIB => SOME g
460            | GG.NOLIB => EM.impossible "stabilize: no library"            | GG.NOLIB => EM.impossible "stabilize: no library"
461            | GG.LIB wrapped =>            | GG.LIB wrapped =>
462                  if not (recomp gp g) then               (case recomp gp g of
463                      (anyerrors := true; NONE)                    NONE => (anyerrors := true; NONE)
464                  else let                  | SOME bfc_acc => let
465                      fun notStable (GG.GROUP { kind, ... }) =                      fun notStable (GG.GROUP { kind, ... }) =
466                          case kind of GG.STABLELIB => false | _ => true                          case kind of GG.STABLELIB => false | _ => true
467                  in                  in
468                      case List.filter notStable (#sublibs grec) of                      case List.filter notStable (#sublibs grec) of
469                          [] => doit wrapped                          [] => doit (wrapped, bfc_acc)
470                        | l => let                        | l => let
471                              val grammar = case l of [_] => " is" | _ => "s are"                              val grammar = case l of [_] => " is" | _ => "s are"
472                              fun ppb pps = let                              fun ppb pps = let
# Line 485  Line 493 
493                                 ppb;                                 ppb;
494                              NONE                              NONE
495                          end                          end
496                  end                    end)
497      end      end
498    
499      fun loadStable gp { getGroup, anyerrors } group = let      fun loadStable gp { getGroup, anyerrors } group = let
# Line 724  Line 732 
732                                 closeIt = BinIO.closeIn,                                 closeIt = BinIO.closeIn,
733                                 work = work,                                 work = work,
734                                 cleanup = fn () => () })                                 cleanup = fn () => () })
735          handle Format => NONE          handle Format => (error ["file is corrupted (old version?)"];
736                              NONE)
737               | IO.Io _ => NONE               | IO.Io _ => NONE
738      end      end
739  end  end

Legend:
Removed from v.399  
changed lines
  Added in v.403

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