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
[smlnj] / 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 758, Fri Dec 22 04:12:36 2000 UTC revision 759, Fri Dec 22 12:29:26 2000 UTC
# Line 33  Line 33 
33      val loadStable :      val loadStable :
34          { getGroup: groupgetter, anyerrors: bool ref } -> groupgetter          { getGroup: groupgetter, anyerrors: bool ref } -> groupgetter
35    
36      val stabilize :      val stabilize : GP.info -> { group: GG.group, anyerrors: bool ref,
37          GP.info -> { group: GG.group, anyerrors: bool ref } -> GG.group option                                   rebindings: SrcPath.rebindings } ->
38                        GG.group option
39  end  end
40    
41  functor StabilizeFn (structure MachDepVC : MACHDEP_VC  functor StabilizeFn (structure MachDepVC : MACHDEP_VC
# Line 532  Line 533 
533      end      end
534    
535      fun stabilize _ { group = GG.ERRORGROUP, ... } = NONE      fun stabilize _ { group = GG.ERRORGROUP, ... } = NONE
536        | stabilize gp { group = g as GG.GROUP grec, anyerrors } = let        | stabilize gp { group = g as GG.GROUP grec, anyerrors, rebindings } =
537            let val policy = #fnpolicy (#param gp)
         val policy = #fnpolicy (#param gp)  
538    
539          fun doit (wrapped, getBFC, vers) = let          fun doit (wrapped, getBFC, vers) = let
540    
# Line 562  Line 562 
562              val _ =              val _ =
563                  if StringSet.isEmpty wrapped then ()                  if StringSet.isEmpty wrapped then ()
564                  else                  else
565                      Say.say ("$Stabilize: wrapping the following privileges:\n"                          Say.say
566                                ("$Stabilize: wrapping the following privileges:\n"
567                               :: map (fn s => ("  " ^ s ^ "\n"))                               :: map (fn s => ("  " ^ s ^ "\n"))
568                                      (StringSet.listItems wrapped))                                      (StringSet.listItems wrapped))
569    
# Line 579  Line 580 
580               *  - The pickled dependency graph.  This graph contains               *  - The pickled dependency graph.  This graph contains
581               *    integer offsets of the binfiles for the individual ML               *    integer offsets of the binfiles for the individual ML
582               *    members. These offsets need to be adjusted by adding               *    members. These offsets need to be adjusted by adding
583               *    s + t + 8. The pickled dependency graph also contains integer                   *    s + t + 8. The pickled dependency graph also contains
584               *    offsets relative to other stable groups.  These offsets                   *    integer offsets relative to other stable groups.  These
585               *    need no further adjustment.                   *    offsets need no further adjustment.
586               *  - Individual binfile contents (concatenated) but without               *  - Individual binfile contents (concatenated) but without
587               *    their static environments.                   *    their static environments. *)
              *)  
588    
589              val inverseMap = mkInverseMap sublibs              val inverseMap = mkInverseMap sublibs
590    
# Line 617  Line 617 
617    
618              fun prepath2list what p = let              fun prepath2list what p = let
619                  fun warn_relabs (abs, descr) = let                  fun warn_relabs (abs, descr) = let
620                      val (relabs, is) = if abs then ("absolute", "is: ")                          val relabs = if abs then "absolute" else "relative"
621                                         else ("relative", "was resolved as: ")                          fun ppb pps = let
622                      fun ppb pps =                              fun space () = PP.add_break pps (1, 0)
623                          (PP.add_newline pps;                              fun string s = PP.add_string pps s
624                           PP.add_string pps (concat ["The ", what,                              fun ss s = (string s; space ())
625                                                      "'s path ", is]);                              fun nl () = PP.add_newline pps
626                           PP.add_string pps descr;                          in
627                           PP.add_newline pps;                              nl ();
628                           PP.add_string pps                              app ss [what, descr, "specified", "using", relabs];
629      "(This means that in order to be able to use the result of stabilization,";                              string "path"; nl ();
630                           PP.add_newline pps;                              app ss ["(This", "means", "that", "in", "order",
631                           PP.add_string pps                                      "to", "be", "able", "to", "use", "the",
632      "objects referred to using this path must be in the same ";                                      "result", "of", "stabilization,",
633                           PP.add_string pps relabs;                                      "objects", "referred", "to", "using",
634                           PP.add_newline pps;                                      "this", "path", "must", "be", "in", "the",
635                           PP.add_string pps "location as they are now.)";                                      "same"];
636                           PP.add_newline pps)                              ss relabs;
637                                app ss ["location", "as", "they", "are"];
638                                string "now.)";
639                                nl ()
640                            end
641                  in                  in
642                      EM.errorNoFile (#errcons gp, anyerrors) SM.nullRegion                      EM.errorNoFile (#errcons gp, anyerrors) SM.nullRegion
643                                     EM.WARN                                     EM.WARN
# Line 655  Line 659 
659    
660                  fun sbn n k (s as (bnodes, snodes)) =                  fun sbn n k (s as (bnodes, snodes)) =
661                      case n of                      case n of
662                          DG.SB_BNODE (DG.BNODE { bininfo = i, ... }, ii, _) =>                              DG.SB_BNODE (DG.BNODE { bininfo = i, ... },
663                                             ii, _) =>
664                          let val (pos, sy) = inverseMap i                          let val (pos, sy) = inverseMap i
665                              val bnodes' =                              val bnodes' =
666                                  StableMap.insert (bnodes, i,                                  StableMap.insert (bnodes, i,
# Line 722  Line 727 
727    
728              fun symbolset ss = let              fun symbolset ss = let
729                  val op $ = PU.$ SS                  val op $ = PU.$ SS
730                  fun raw_ss ss = "s" $ [list symbol (SymbolSet.listItems ss)]                      fun raw_ss ss =
731                            "s" $ [list symbol (SymbolSet.listItems ss)]
732              in              in
733                  share SSs raw_ss ss                  share SSs raw_ss ss
734              end              end
# Line 756  Line 762 
762              fun abspath p = let              fun abspath p = let
763                  val op $ = PU.$ AP                  val op $ = PU.$ AP
764              in              in
765                  "p" $ [list string (prepath2list "library" (SrcPath.pre p))]                      "p" $ [list string (prepath2list "library"
766                                                         (SrcPath.pre p))]
767              end              end
768    
769              fun sn n = let              fun sn n = let
# Line 774  Line 781 
781                  val op $ = PU.$ SBN                  val op $ = PU.$ SBN
782              in              in
783                  case x of                  case x of
784                      DG.SB_BNODE (DG.BNODE { bininfo = i, ... }, _, _) => let                          DG.SB_BNODE (DG.BNODE { bininfo = i, ... }, _, _) =>
785                          val (pos, sy) = inverseMap i                          let val (pos, sy) = inverseMap i
786                      in                      in
787                          "2" $ [int pos, symbol sy]                          "2" $ [int pos, symbol sy]
788                      end                      end
# Line 863  Line 870 
870              val offset_adjustment = dg_sz + 4 + libstamp_nbytes              val offset_adjustment = dg_sz + 4 + libstamp_nbytes
871    
872              (* We could generate the graph for a stable group here directly              (* We could generate the graph for a stable group here directly
873               * by transcribing the original graph.  However, it is cumbersome                   * by transcribing the original graph.  However, it is
874               * and is likely to result in a larger memory footprint because                   * cumbersome and is likely to result in a larger memory
875               * we don't get the benefit of lazy unpickling of environments.                   * footprint because we don't get the benefit of lazy
876                     * unpickling of environments.
877               * It seems easier to simply rely on "loadStable" to re-fetch               * It seems easier to simply rely on "loadStable" to re-fetch
878               * the stable graph. *)               * the stable graph. *)
879              fun refetchStableGroup () = let              fun refetchStableGroup () = let
880                  fun getGroup (_, p, _, _) = let                  fun getGroup (_, p, _, _) = let
881                      fun theSublib (q, _, _) = SrcPath.compare (p, q) = EQUAL                          fun theSublib (q, _, _) =
882                                SrcPath.compare (p, q) = EQUAL
883                      fun force f = f ()                      fun force f = f ()
884                  in                  in
885                      Option.map (force o #2) (List.find theSublib sublibs)                      Option.map (force o #2) (List.find theSublib sublibs)
886                  end                  end
887              in              in
                 (* We don't need to worry about rebindings here. *)  
888                  loadStable { getGroup = getGroup, anyerrors = anyerrors }                  loadStable { getGroup = getGroup, anyerrors = anyerrors }
889                             (gp, grouppath, NONE, [])                                 (gp, grouppath, NONE, rebindings)
890              end              end
891    
892              fun writeInt32 (s, i) = let              fun writeInt32 (s, i) = let
# Line 889  Line 897 
897              end              end
898              val memberlist = rev (!members)              val memberlist = rev (!members)
899    
900              (* We do not use version information for making the stable path! *)                  (* don't use version information for making the stable path! *)
901              fun mksname () =              fun mksname () =
902                  FilenamePolicy.mkStableName policy (grouppath, NONE)                  FilenamePolicy.mkStableName policy (grouppath, NONE)
903    
904              val libstamp_bytes = Pid.toBytes libstamp              val libstamp_bytes = Pid.toBytes libstamp
905              val _ =              val _ =
906                  if Word8Vector.length libstamp_bytes <> libstamp_nbytes then                      if Word8Vector.length libstamp_bytes <> libstamp_nbytes
907                      EM.impossible "stabilize: libstamp size wrong"                      then EM.impossible "stabilize: libstamp size wrong"
908                  else ()                  else ()
909              fun work outs =              fun work outs =
910                  (BinIO.output (outs, libstamp_bytes);                  (BinIO.output (outs, libstamp_bytes);
# Line 938  Line 946 
946                      case List.filter notStable (#sublibs grec) of                      case List.filter notStable (#sublibs grec) of
947                          [] => doit (wrapped, bfc_acc, version)                          [] => doit (wrapped, bfc_acc, version)
948                        | l => let                        | l => let
949                              val grammar = case l of [_] => " is" | _ => "s are"                                   val grammar =
950                                         case l of [_] => " is" | _ => "s are"
951                              fun ppb pps = let                              fun ppb pps = let
952                                  fun loop [] = ()                                  fun loop [] = ()
953                                    | loop ((p, _, _) :: t) =                                    | loop ((p, _, _) :: t) =
# Line 956  Line 965 
965                              val errcons = #errcons gp                              val errcons = #errcons gp
966                              val gdescr = SrcPath.descr (#grouppath grec)                              val gdescr = SrcPath.descr (#grouppath grec)
967                          in                          in
968                              EM.errorNoFile (errcons, anyerrors) SM.nullRegion                                   EM.errorNoFile (errcons, anyerrors)
969                                            SM.nullRegion
970                                 EM.COMPLAIN                                 EM.COMPLAIN
971                                 (gdescr ^ " cannot be stabilized")                                 (gdescr ^ " cannot be stabilized")
972                                 ppb;                                 ppb;
Legend:
Removed from v.758  
changed lines
  Added in v.759
root@smlnj-gforge.cs.uchicago.edu
 ViewVC Help
Powered by ViewVC 1.0.0  
Powered By FusionForge