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 305 - (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 :     not (TStamp.earlier (ts, SmlInfo.lastseen i))
26 :     andalso let
27 :     val demanded =
28 :     PidSet.addList (PidSet.empty, BF.cmDataOf bfc)
29 :     in
30 :     PidSet.equal (provided, demanded)
31 :     end
32 : blume 295 in
33 : blume 305 case SmlInfoMap.find (!smlmap, i) of
34 : blume 295 NONE => NONE
35 : blume 301 | SOME (memo, ts) =>
36 :     if isValid (memo, ts) then SOME memo
37 : blume 305 else (smlmap := #1 (SmlInfoMap.remove (!smlmap, i));
38 : blume 295 NONE)
39 :     end
40 :    
41 : blume 301 fun recomp_memo_sml0 (i, memo) = let
42 :     val ts = SmlInfo.lastseen i
43 :     val tmemo = (memo, ts)
44 :     in
45 :     discard_value i;
46 : blume 305 smlmap := SmlInfoMap.insert (!smlmap, i, tmemo)
47 : blume 301 end
48 : blume 295
49 :     fun discard (arg as (_, { bfc, ctxt })) = (BF.discardCode bfc; arg)
50 :    
51 :     val recomp_memo_sml =
52 :     if discard_code then recomp_memo_sml0 o discard
53 :     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 :     if discard_code then recomp_memo_stable0 o discard
61 :     else recomp_memo_stable0
62 :    
63 : blume 305 fun bfc_fetch_sml i = #bfc (#1 (valOf (SmlInfoMap.find (!smlmap, i))))
64 :     fun bfc_fetch_stable i = #bfc (valOf (StableMap.find (!stablemap, i)))
65 : blume 295 end

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