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 307, Tue Jun 1 09:38:28 1999 UTC revision 308, Wed Jun 2 01:26:19 1999 UTC
# Line 34  Line 34 
34                           val compare = compare                           val compare = compare
35          end)          end)
36    
37      fun stabilize (g as GG.GROUP grec, binSizeOf, binCopy, gp) =      fun genStableInfoMap (exports, group) = let
38            (* find all the exported bnodes that are in the same group: *)
39            fun add (((_, DG.SB_BNODE (n as DG.BNODE b)), _), m) = let
40                val i = #bininfo b
41            in
42                if AbsPath.compare (BinInfo.group i, group) = EQUAL then
43                    IntBinaryMap.insert (m, BinInfo.offset i, n)
44                else m
45            end
46              | add (_, m) = m
47        in
48            SymbolMap.foldl add IntBinaryMap.empty exports
49        end
50    
51        fun stabilize gp (g as GG.GROUP grec, binSizeOf, copyBin, outs) =
52          case #stableinfo grec of          case #stableinfo grec of
53              GG.STABLE _ => g              GG.STABLE _ => g
54            | GG.NONSTABLE granted => let            | GG.NONSTABLE granted => let
55    
56                    (* this needs to be refined (perhaps) *)
57                    val grpSrcInfo = (EM.defaultConsumer (), ref false)
58    
59                  val exports = #exports grec                  val exports = #exports grec
60                    val islib = #islib grec
61                    val required = StringSet.difference (#required grec,
62                                                         granted)
63                    val grouppath = #grouppath grec
64                    val subgroups = #subgroups grec
65    
66                  (* The format of a stable archive is the following:                  (* The format of a stable archive is the following:
67                   *  - It starts with the size s of the pickled dependency                   *  - It starts with the size s of the pickled dependency
# Line 53  Line 75 
75                   *  - Individual binfile contents (concatenated).                   *  - Individual binfile contents (concatenated).
76                   *)                   *)
77    
                 val offsetDict = ref SmlInfoMap.empty  
78                  val members = ref []                  val members = ref []
79                  val registerOffset = let                  val (registerOffset, getOffset) = let
80                        val dict = ref SmlInfoMap.empty
81                      val cur = ref 0                      val cur = ref 0
82                      fun reg (i, sz) = let                      fun reg (i, sz) = let
83                          val os = !cur                          val os = !cur
84                      in                      in
85                          cur := os + sz;                          cur := os + sz;
86                          offsetDict := SmlInfoMap.insert (!offsetDict, i, os);                          dict := SmlInfoMap.insert (!dict, i, os);
87                          members := i :: (!members);                          members := i :: (!members);
88                          os                          os
89                      end                      end
90                        fun get i = valOf (SmlInfoMap.find (!dict, i))
91                  in                  in
92                      reg                      (reg, get)
93                  end                  end
94    
95                  fun w_list w_item [] k m =                  fun w_list w_item [] k m =
# Line 183  Line 206 
206    
207                  fun w_privileges p = w_list w_string (StringSet.listItems p)                  fun w_privileges p = w_list w_string (StringSet.listItems p)
208    
209                  fun pickle_group (GG.GROUP g, granted) = let                  fun pickle_group () = let
210                      fun w_sg (GG.GROUP g) = w_abspath (#grouppath g)                      fun w_sg (GG.GROUP g) = w_abspath (#grouppath g)
                     val req' = StringSet.difference (#required g, granted)  
211                      fun k0 m = []                      fun k0 m = []
212                      val m0 = (0, Map.empty)                      val m0 = (0, Map.empty)
213                  in                  in
214                      concat                      concat
215                         (w_exports (#exports g)                         (w_exports exports
216                            (w_bool (#islib g)                             (w_bool islib
217                                (w_privileges req'                                (w_privileges required
218                                     (w_abspath (#grouppath g)                                      (w_list w_sg subgroups k0))) m0)
                                          (w_list w_sg (#subgroups g) k0)))) m0)  
219                  end                  end
220                  val pickle = pickle_group (g, granted)  
221                    val pickle = pickle_group ()
222                  val sz = size pickle                  val sz = size pickle
223                    val offset_adjustment = sz + 4
224    
225                    fun mkStableGroup () = let
226                        val m = ref SmlInfoMap.empty
227                        fun sn (DG.SNODE (n as { smlinfo, ... })) =
228                            case SmlInfoMap.find (!m, smlinfo) of
229                                SOME n => n
230                              | NONE => let
231                                    val li = map sn (#localimports n)
232                                    val gi = map fsbn (#globalimports n)
233                                    val sourcepath = SmlInfo.sourcepath smlinfo
234                                    val spec = AbsPath.spec sourcepath
235                                    val offset =
236                                        getOffset smlinfo + offset_adjustment
237                                    val share = SmlInfo.share smlinfo
238                                    val locs = SmlInfo.errorLocation gp smlinfo
239                                    val error = EM.errorNoSource grpSrcInfo locs
240                                    val i = BinInfo.new { group = grouppath,
241                                                          spec = spec,
242                                                          offset = offset,
243                                                          share = share,
244                                                          error = error }
245                                    val n = DG.BNODE { bininfo = i,
246                                                       localimports = li,
247                                                       globalimports = gi }
248              in              in
249                  Dummy.f ()                                  m := SmlInfoMap.insert (!m, smlinfo, n);
250                                    n
251              end              end
252    
253      fun g (getGroup, bn2env, grpSrcInfo, group, s) = let                      and sbn (DG.SB_SNODE n) = sn n
254                          | sbn (DG.SB_BNODE n) = n
255    
256                        and fsbn (f, n) = (f, sbn n)
257    
258                        fun impexp ((f, n), e) = ((f, DG.SB_BNODE (sbn n)), e)
259    
260                        val exports = SymbolMap.map impexp (#exports grec)
261                        val simap = genStableInfoMap (exports, grouppath)
262                    in
263                        GG.GROUP { exports = exports,
264                                   islib = islib,
265                                   required = required,
266                                   grouppath = grouppath,
267                                   subgroups = subgroups,
268                                   stableinfo = GG.STABLE simap }
269                    end
270    
271                    fun writeInt32 (s, i) = let
272                        val a = Word8Array.array (4, 0w0)
273                        val _ = Pack32Big.update (a, 0, LargeWord.fromInt i)
274                    in
275                        BinIO.output (s, Word8Array.extract (a, 0, NONE))
276                    end
277                in
278                    writeInt32 (outs, sz);
279                    BinIO.output (outs, Byte.stringToBytes pickle);
280                    app (copyBin outs) (rev (!members));
281                    mkStableGroup ()
282                end
283    
284        fun g (getGroup, bn2env, group, s) = let
285    
286            (* we don't care about errors... (?) *)
287            val grpSrcInfo = (EM.defaultConsumer (), ref false)
288    
289          exception Format          exception Format
290    
# Line 413  Line 495 
495              val exports = r_exports ()              val exports = r_exports ()
496              val islib = r_bool ()              val islib = r_bool ()
497              val required = r_privileges ()              val required = r_privileges ()
             val grouppath = r_abspath ()  
498              val subgroups = r_list (getGroup o r_abspath) ()              val subgroups = r_list (getGroup o r_abspath) ()
499              (* find all the exported bnodes that are in the same group: *)              val simap = genStableInfoMap (exports, group)
             fun add (((_, DG.SB_BNODE (n as DG.BNODE b)), _), m) = let  
                     val i = #bininfo b  
                 in  
                     if AbsPath.compare (BinInfo.group i, group) = EQUAL then  
                         IntBinaryMap.insert (m, BinInfo.offset i, n)  
                     else m  
                 end  
               | add (_, m) = m  
             val simap = SymbolMap.foldl add IntBinaryMap.empty exports  
500          in          in
501              GG.GROUP { exports = exports,              GG.GROUP { exports = exports,
502                         islib = islib,                         islib = islib,
503                         required = required,                         required = required,
504                         grouppath = grouppath,                         grouppath = group,
505                         subgroups = subgroups,                         subgroups = subgroups,
506                         stableinfo = GG.STABLE simap }                         stableinfo = GG.STABLE simap }
507          end          end

Legend:
Removed from v.307  
changed lines
  Added in v.308

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