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/MLRISC/gc-safety/gc-typing.sml
ViewVC logotype

Annotation of /sml/trunk/src/MLRISC/gc-safety/gc-typing.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 476 - (view) (download)

1 : monnier 427 (*
2 :     * This module is responsible for propagating gc type information.
3 :     *)
4 :     functor GCTyping
5 :     (structure IR : MLRISC_IR
6 :     structure GCProps : GC_PROPERTIES
7 : monnier 475 structure GCMap : GC_MAP
8 : monnier 427 structure Props : INSN_PROPERTIES
9 : monnier 475 sharing GCMap.GC = GCProps.GC
10 : monnier 427 sharing IR.I = GCProps.I = Props.I
11 :     ) : GC_TYPING =
12 :     struct
13 :    
14 :     structure IR = IR
15 :     structure CFG = IR.CFG
16 :     structure GC = GCProps.GC
17 :     structure G = Graph
18 :     structure An = Annotations
19 :    
20 :     fun gcTyping(IR as G.GRAPH cfg) =
21 : monnier 475 case #get GCMap.GCMAP (CFG.getAnnotations IR)
22 : monnier 427 of NONE => IR (* no gc map; do nothing *)
23 :     | SOME gcmap =>
24 :     let val lookup = Intmap.map gcmap
25 :     val add = Intmap.add gcmap
26 :     fun update(dst,ty) =
27 :     (lookup dst; ()) handle _ => add(dst,ty)
28 :     fun move(dst,src) =
29 :     (lookup dst; ()) handle _ =>
30 :     (add(dst,lookup src) handle _ => ())
31 :     val prop = GCProps.propagate {lookup=lookup,update=update}
32 :     fun process(b,CFG.BLOCK{insns,...}) =
33 :     let fun scan [] = ()
34 :     | scan(i::is) =
35 :     (case Props.instrKind i of
36 :     Props.IK_COPY =>
37 :     let val (dst,src) = Props.moveDstSrc i
38 :     fun copy(d::ds,s::ss) = (move(d,s); copy(ds,ss))
39 :     | copy _ = ()
40 :     in copy(dst,src)
41 :     end
42 :     | Props.IK_GROUP => () (* skip *)
43 :     | _ => prop i handle _ => ();
44 :     scan is
45 :     )
46 :     in scan(rev(!insns))
47 :     end
48 :     in #forall_nodes cfg process;
49 :     IR
50 :     end
51 :    
52 :     end

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