Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/cm/compile/recomp-persstate-fn.sml
ViewVC logotype

Annotation of /sml/trunk/src/cm/compile/recomp-persstate-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 355 - (view) (download)

1 : blume 295 (*
2 :     * Build a new "recompilation-related" persistent state.
3 :     *
4 :     * (C) 1999 Lucent Technologies, Bell Laboratories
5 :     *
6 :     * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
7 :     *)
8 : blume 301 functor RecompPersstateFn
9 :     (structure MachDepVC : MACHDEP_VC
10 :     val discard_code : bool
11 :     val discard_value : SmlInfo.info -> unit) :> RECOMP_PERSSTATE = struct
12 :    
13 : blume 295 structure MachDepVC = MachDepVC
14 :     structure BF = MachDepVC.Binfile
15 :     structure E = GenericVC.Environment
16 :    
17 :     type recomp_memo = { bfc: BF.bfContent, ctxt: E.staticEnv }
18 : blume 301 type recomp_tmemo = recomp_memo * TStamp.t
19 : blume 295
20 : blume 305 val smlmap = ref (SmlInfoMap.empty: recomp_tmemo SmlInfoMap.map)
21 : blume 295 val stablemap = ref (StableMap.empty: recomp_memo StableMap.map)
22 :    
23 : blume 297 fun recomp_look_sml (i, provided, gp) = let
24 : blume 301 fun isValid ({ bfc, ctxt }, ts) =
25 : blume 345 not (TStamp.needsUpdate { source = SmlInfo.lastseen i,
26 :     target = ts })
27 : blume 301 andalso let
28 :     val demanded =
29 :     PidSet.addList (PidSet.empty, BF.cmDataOf bfc)
30 :     in
31 :     PidSet.equal (provided, demanded)
32 :     end
33 : blume 295 in
34 : blume 305 case SmlInfoMap.find (!smlmap, i) of
35 : blume 295 NONE => NONE
36 : blume 301 | SOME (memo, ts) =>
37 :     if isValid (memo, ts) then SOME memo
38 : blume 305 else (smlmap := #1 (SmlInfoMap.remove (!smlmap, i));
39 : blume 295 NONE)
40 :     end
41 :    
42 : blume 301 fun recomp_memo_sml0 (i, memo) = let
43 :     val ts = SmlInfo.lastseen i
44 :     val tmemo = (memo, ts)
45 :     in
46 :     discard_value i;
47 : blume 305 smlmap := SmlInfoMap.insert (!smlmap, i, tmemo)
48 : blume 301 end
49 : blume 295
50 :     val recomp_memo_sml =
51 : blume 320 if discard_code then
52 :     (fn x => (BF.discardCode (#bfc (#2 x)); recomp_memo_sml0 x))
53 : blume 295 else recomp_memo_sml0
54 :    
55 :     fun recomp_look_stable i = StableMap.find (!stablemap, i)
56 :     fun recomp_memo_stable0 (i, memo) =
57 :     stablemap := StableMap.insert (!stablemap, i, memo)
58 :    
59 :     val recomp_memo_stable =
60 : blume 320 if discard_code then
61 :     (fn x => (BF.discardCode (#bfc (#2 x)); recomp_memo_stable0 x))
62 : blume 295 else recomp_memo_stable0
63 :    
64 : blume 305 fun bfc_fetch_sml i = #bfc (#1 (valOf (SmlInfoMap.find (!smlmap, i))))
65 : blume 355 handle Option => raise Fail "bfc_fetch_sml"
66 : blume 305 fun bfc_fetch_stable i = #bfc (valOf (StableMap.find (!stablemap, i)))
67 : blume 355 handle Option => raise Fail "bfc_fetch_stable"
68 : blume 295 end

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