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 400, Thu Aug 26 16:23:37 1999 UTC revision 404, Wed Sep 1 07:03:22 1999 UTC
# Line 1  Line 1 
1    (*
2     * Link traversals.
3     *   - manages shared state
4     *
5     * (C) 1999 Lucent Technologies, Bell Laboratories
6     *
7     * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
8     *)
9  local  local
10      structure GP = GeneralParams      structure GP = GeneralParams
11      structure DG = DependencyGraph      structure DG = DependencyGraph
# Line 10  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 17  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 28  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 60  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 167 
167              end              end
168          end          end
169    
170          fun link_sml (gp, i, getE, snl) = let          fun link_sml (gp, i, getBFC, getE, snl) = let
171              fun fresh () = let              fun fresh () = let
172                  val bfc = getBFC i                  val bfc = getBFC i
173              in              in
# Line 220  Line 233 
233                          end                          end
234                      in                      in
235                          case StableMap.find (!stablemap, i) of                          case StableMap.find (!stablemap, i) of
236                              SOME (B (f, i, l)) => (f, SOME (i, l))                              SOME (B (f, i, [])) =>
237                                    (case BinInfo.sh_mode i of
238                                         Sharing.DONTSHARE => (f, SOME (i, []))
239                                       | _ => (f, NONE))
240                              | SOME (B (f, i, l)) => (f, SOME (i, l))
241                            | NONE =>                            | NONE =>
242                                  (case StableMap.find (!localmap, i) of                                  (case StableMap.find (!localmap, i) of
243                                       SOME x => x                                       SOME x => x
# Line 261  Line 278 
278                      | _ => ())                      | _ => ())
279          end          end
280    
281          fun newTraversal (group as GG.GROUP { exports, ... }) = let          fun newTraversal (group as GG.GROUP { exports, ... }, getBFC) = let
282              val _ = registerGroup group              val _ = registerGroup group
283    
284              val l_stablemap = ref StableMap.empty              val l_stablemap = ref StableMap.empty
# Line 309  Line 326 
326                          val gi = foldl add (SOME o getPerv, [])                          val gi = foldl add (SOME o getPerv, [])
327                                             (map fsbn globalimports)                                             (map fsbn globalimports)
328                          val (getE, snl) = foldl add gi (map sn localimports)                          val (getE, snl) = foldl add gi (map sn localimports)
329                          fun thunk gp = link_sml (gp, i, getE, snl)                          fun thunk gp = link_sml (gp, i, getBFC, getE, snl)
330                          val m_thunk = memoize thunk                          val m_thunk = memoize thunk
331                      in                      in
332                          l_smlmap := SmlInfoMap.insert (!l_smlmap, i, m_thunk);                          l_smlmap := SmlInfoMap.insert (!l_smlmap, i, m_thunk);

Legend:
Removed from v.400  
changed lines
  Added in v.404

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