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/compile/link.sml
ViewVC logotype

Diff of /sml/trunk/src/cm/compile/link.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 402, Fri Aug 27 07:50:43 1999 UTC revision 446, Wed Sep 29 03:29:07 1999 UTC
# Line 18  Line 18 
18      type env = E.dynenv      type env = E.dynenv
19  in  in
20      signature LINK = sig      signature LINK = sig
21    
22            type bfc
23            type bfcGetter = SmlInfo.info -> bfc
24    
25          (* Evict value from cache if it exists *)          (* Evict value from cache if it exists *)
26          val evict : GP.info -> SmlInfo.info -> unit          val evict : GP.info -> SmlInfo.info -> unit
27    
# Line 25  Line 29 
29           * meanwhile evicted ones. *)           * meanwhile evicted ones. *)
30          val cleanup : GP.info -> unit          val cleanup : GP.info -> unit
31    
32          val newTraversal : GG.group ->          val newTraversal : GG.group * bfcGetter ->
33              { group: GP.info -> env option,              { group: GP.info -> env option,
34                exports: (GP.info -> env option) SymbolMap.map }                exports: (GP.info -> env option) SymbolMap.map }
35    
# Line 36  Line 40 
40      end      end
41    
42      functor LinkFn (structure MachDepVC : MACHDEP_VC      functor LinkFn (structure MachDepVC : MACHDEP_VC
43                      val getBFC : SmlInfo.info -> MachDepVC.Binfile.bfContent                      val system_values : env ref) :> LINK
44                      val system_values : env ref) :> LINK = struct          where type bfc = MachDepVC.Binfile.bfContent =
45        struct
46    
47          structure BF = MachDepVC.Binfile          structure BF = MachDepVC.Binfile
48    
49            type bfc = BF.bfContent
50            type bfcGetter = SmlInfo.info -> bfc
51    
52          type bfun = GP.info -> E.dynenv -> E.dynenv          type bfun = GP.info -> E.dynenv -> E.dynenv
53    
54          datatype bnode =          datatype bnode =
# Line 68  Line 76 
76              raise exn              raise exn
77          end          end
78    
79          fun execute (bfc, de) = let          fun execute (bfc, de) =
             fun exec () = E.dynamicPart (BF.exec (bfc, de))  
         in  
80              case sysval (BF.exportPidOf bfc) of              case sysval (BF.exportPidOf bfc) of
81                  NONE => exec ()                  NONE => BF.exec (bfc, de)
82                | SOME de => de                | SOME de' => de'
         end  
83    
84          fun memoize thunk = let          fun memoize thunk = let
85              val r = ref (fn _ => raise Fail "Link:memoize")              val r = ref (fn _ => raise Fail "Link:memoize")
# Line 154  Line 159 
159                      handle exn =>                      handle exn =>
160                          exn_err ("unable to load library module",                          exn_err ("unable to load library module",
161                                   error, descr, exn)                                   error, descr, exn)
                 val epid = BF.exportPidOf bfc  
162              in              in
163                  execute (bfc, e)                  execute (bfc, e)
164                  handle exn => exn_err ("link-time exception in library code",                  handle exn => exn_err ("link-time exception in library code",
# Line 162  Line 166 
166              end              end
167          end          end
168    
169          fun link_sml (gp, i, getE, snl) = let          fun link_sml (gp, i, getBFC, getE, snl) = let
170              fun fresh () = let              fun fresh () = let
171                  val bfc = getBFC i                  val bfc = getBFC i
172              in              in
# Line 195  Line 199 
199          end          end
200    
201          fun registerGroup g = let          fun registerGroup g = let
             val GG.GROUP { grouppath, kind, sublibs, ... } = g  
202              val visited = ref SrcPathSet.empty              val visited = ref SrcPathSet.empty
203                fun registerGroup' g = let
204                    val GG.GROUP { grouppath, kind, sublibs, ... } = g
205              fun registerStableLib (GG.GROUP { exports, ... }) = let              fun registerStableLib (GG.GROUP { exports, ... }) = let
206                  val localmap = ref StableMap.empty                  val localmap = ref StableMap.empty
207                  fun bn (DG.PNODE p) =                  fun bn (DG.PNODE p) =
208                      (fn gp => fn _ => prim2dyn p gp, NONE)                      (fn gp => fn _ => prim2dyn p gp, NONE)
209                    | bn (DG.BNODE n) = let                    | bn (DG.BNODE n) = let
210                          val { bininfo = i, localimports, globalimports } = n                              val { bininfo = i, localimports, globalimports } =
211                                    n
212                          fun new () = let                          fun new () = let
213                              val e0 = (getPerv, [])                              val e0 = (getPerv, [])
214                              fun join ((f, NONE), (e, l)) =                              fun join ((f, NONE), (e, l)) =
# Line 239  Line 245 
245                                     | NONE => let                                     | NONE => let
246                                           val x = new ()                                           val x = new ()
247                                       in                                       in
248                                           localmap :=                                                    localmap := StableMap.insert
249                                              StableMap.insert (!localmap, i, x);                                                         (!localmap, i, x);
250                                           x                                           x
251                                       end)                                       end)
252                      end                      end
# Line 250  Line 256 
256                  fun sbn (DG.SB_SNODE n) =                  fun sbn (DG.SB_SNODE n) =
257                      EM.impossible "Link:SNODE in stable lib"                      EM.impossible "Link:SNODE in stable lib"
258                    | sbn (DG.SB_BNODE (DG.PNODE _, _)) = ()                    | sbn (DG.SB_BNODE (DG.PNODE _, _)) = ()
259                    | sbn (DG.SB_BNODE (n as DG.BNODE { bininfo, ... }, _)) = let                        | sbn (DG.SB_BNODE (n as DG.BNODE { bininfo, ... }, _)) =
260                            let
261                          val b as B (_, i, _) =                          val b as B (_, i, _) =
262                              case bn n of                              case bn n of
263                                  (f, NONE) => B (f, bininfo, [])                                  (f, NONE) => B (f, bininfo, [])
# Line 267  Line 274 
274          in          in
275              if SrcPathSet.member (!visited, grouppath) then ()              if SrcPathSet.member (!visited, grouppath) then ()
276              else (visited := SrcPathSet.add (!visited, grouppath);              else (visited := SrcPathSet.add (!visited, grouppath);
277                    app registerGroup sublibs;                        app (registerGroup' o #2) sublibs;
278                    case kind of                    case kind of
279                        GG.STABLELIB => registerStableLib g                        GG.STABLELIB => registerStableLib g
280                      | _ => ())                      | _ => ())
281          end          end
282            in
283                registerGroup' g
284            end
285    
286            fun newTraversal (group as GG.GROUP { exports, ... }, getBFC) = let
287    
         fun newTraversal (group as GG.GROUP { exports, ... }) = let  
288              val _ = registerGroup group              val _ = registerGroup group
289    
290              val l_stablemap = ref StableMap.empty              val l_stablemap = ref StableMap.empty
# Line 321  Line 332 
332                          val gi = foldl add (SOME o getPerv, [])                          val gi = foldl add (SOME o getPerv, [])
333                                             (map fsbn globalimports)                                             (map fsbn globalimports)
334                          val (getE, snl) = foldl add gi (map sn localimports)                          val (getE, snl) = foldl add gi (map sn localimports)
335                          fun thunk gp = link_sml (gp, i, getE, snl)                          fun thunk gp = link_sml (gp, i, getBFC, getE, snl)
336                          val m_thunk = memoize thunk                          val m_thunk = memoize thunk
337                      in                      in
338                          l_smlmap := SmlInfoMap.insert (!l_smlmap, i, m_thunk);                          l_smlmap := SmlInfoMap.insert (!l_smlmap, i, m_thunk);

Legend:
Removed from v.402  
changed lines
  Added in v.446

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