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/aliasing/pointsTo.sml
ViewVC logotype

Annotation of /sml/trunk/src/MLRISC/aliasing/pointsTo.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1126 - (view) (download)

1 : monnier 409 (*
2 : leunga 585 * This module performs low-level flow insensitive points-to
3 :     * analysis for type-safe languages.
4 : monnier 409 *)
5 :     structure PointsTo : POINTS_TO =
6 :     struct
7 :    
8 : leunga 585 datatype edgekind = PI | DOM | RAN | RECORD | MARK
9 : monnier 409
10 : leunga 744 structure C = CellsBasis
11 :    
12 : leunga 585 datatype cell =
13 :     LINK of region
14 : leunga 744 | SREF of C.cell * edges ref
15 :     | WREF of C.cell * edges ref
16 :     | SCELL of C.cell * edges ref
17 :     | WCELL of C.cell * edges ref
18 :     | TOP of {mutable:bool, id:C.cell, name:string}
19 : leunga 585 (* a collapsed node *)
20 : monnier 409
21 : leunga 585 withtype region = cell ref
22 :     and edges = (edgekind * int * region) list
23 : monnier 409
24 :     fun error msg = MLRiscErrorMsg.error("PointsTo",msg)
25 :    
26 : leunga 585 (* PI > DOM > RAN > RECORD *)
27 :     fun greaterKind(PI,_) = false
28 :     | greaterKind(DOM,PI) = false
29 :     | greaterKind(RAN,(PI | DOM)) = false
30 :     | greaterKind(RECORD,(PI | DOM | RAN)) = false
31 :     | greaterKind(MARK,(PI | DOM | RAN | RECORD)) = false
32 :     | greaterKind _ = true
33 : monnier 409
34 : leunga 585 fun less(k,i,k',i') = k=k' andalso i > i' orelse greaterKind(k,k')
35 : monnier 409
36 : leunga 585 val sort : (edgekind * int * region) list ->
37 :     (edgekind * int * region) list =
38 :     ListMergeSort.sort (fn ((k,i,_),(k',i',_)) => less(k,i,k',i'))
39 : monnier 409
40 : leunga 744 val newMem = ref(fn _ => error "newMem") : (unit -> C.cell) ref
41 : monnier 409 fun reset f = newMem := f
42 :    
43 : leunga 585 fun newSRef() = ref(SREF(!newMem(),ref []))
44 :     fun newWRef() = ref(WREF(!newMem(),ref []))
45 :     fun newSCell() = ref(SCELL(!newMem(),ref []))
46 :     fun newWCell() = ref(WCELL(!newMem(),ref []))
47 :     fun newTop{name,mutable} =
48 :     ref(TOP{mutable=mutable, id= !newMem(), name=name})
49 : monnier 409
50 :     fun find(ref(LINK x)) = find x
51 :     | find x = x
52 :    
53 : leunga 585 fun mut(ref(LINK x)) = mut x
54 :     | mut(r as ref(TOP{mutable=false, id, name})) =
55 :     (r := TOP{mutable=true, id=id, name=name})
56 :     | mut(r as ref(SCELL x)) = r := SREF x
57 :     | mut(r as ref(WCELL x)) = r := WREF x
58 :     | mut _ = ()
59 : monnier 409
60 : leunga 585 and weak(ref(LINK x)) = weak x
61 :     | weak(ref(TOP _)) = ()
62 :     | weak(r as ref(SCELL x)) = (r := WCELL x; mergePis x)
63 :     | weak(r as ref(SREF x)) = (r := WREF x; mergePis x)
64 :     | weak _ = ()
65 : monnier 409
66 : leunga 585 and mergePis(_,edges) =
67 :     let val x = newSCell()
68 :     fun merge([],es') = es'
69 :     | merge((PI,_,y)::es,es') = (unify(x,y); merge(es, es'))
70 :     | merge(e::es,es') = merge(es,e::es')
71 :     in edges := (PI,0,x)::merge(!edges, []) end
72 :    
73 :     and getIth(k,i,ref(LINK x)) = getIth(k,i,x)
74 :     | getIth(k,i,r as ref(TOP _)) = r
75 :     | getIth(k,i,ref(SREF(_,edges))) = getIth'(k,i,edges)
76 :     | getIth(k,i,ref(WREF(_,edges))) = getIth'(k,i,edges)
77 :     | getIth(k,i,ref(SCELL(_,edges))) = getIth'(k,i,edges)
78 :     | getIth(k,i,ref(WCELL(_,edges))) = getIth'(k,i,edges)
79 :    
80 :     and getIth'(k,i,edges) =
81 :     let fun search((k',i',x)::es) =
82 :     if k = k' andalso i = i' then find x else search es
83 :     | search [] =
84 :     let val x = newSCell()
85 :     in edges := (k,i,x) :: !edges; x end
86 :     in search(!edges) end
87 :    
88 :     and unify(x,y) =
89 : monnier 409 let val x = find x
90 :     val y = find y
91 : leunga 585 fun linkImmut(edges,x,y) = (x := LINK y; collapseAll(!edges,y))
92 :     fun linkMut(edges,x,y) = (x := LINK y; mut y; collapseAll(!edges,y))
93 :     fun linky(ex,ey,x,y) = (x := LINK y; ey := unifyList(!ex,!ey))
94 :     fun linkx(ex,ey,x,y) = (y := LINK x; ex := unifyList(!ex,!ey))
95 :     fun linkWREF(ex,ey,id,x,y) =
96 :     let val ey = unifyList(!ex,!ey)
97 :     val n = WREF(id,ref ey)
98 :     in x := LINK y; y := n end
99 :    
100 : monnier 409 in if x = y then () else
101 :     case (!x,!y) of
102 : leunga 585 (TOP{mutable=false,...},TOP{mutable=false, ...}) => (x := LINK y)
103 :     | (TOP _, TOP _) => (x := LINK y; mut y)
104 :    
105 :     | (SREF(_,edges), TOP _) => linkMut(edges,x,y)
106 :     | (WREF(_,edges), TOP _) => linkMut(edges,x,y)
107 :     | (SCELL(_,edges), TOP _) => linkImmut(edges,x,y)
108 :     | (WCELL(_,edges), TOP _) => linkImmut(edges,x,y)
109 :    
110 :     | (TOP _, SREF(_,edges)) => linkMut(edges,y,x)
111 :     | (TOP _, WREF(_,edges)) => linkMut(edges,y,x)
112 :     | (TOP _, SCELL(_,edges)) => linkImmut(edges,y,x)
113 :     | (TOP _, WCELL(_,edges)) => linkImmut(edges,y,x)
114 :    
115 :     | (WREF(_,e1), WREF(_,e2)) => linky(e1,e2,x,y)
116 :     | (SREF(_,e1), WREF(_,e2)) => linky(e1,e2,x,y)
117 :     | (WCELL(_,e1),WREF(_,e2)) => linky(e1,e2,x,y)
118 :     | (SCELL(_,e1),WREF(_,e2)) => linky(e1,e2,x,y)
119 :    
120 :     | (WREF(_,e1), SREF(_,e2)) => linkx(e1,e2,x,y)
121 :     | (SREF(_,e1), SREF(_,e2)) => linkx(e1,e2,x,y)
122 :     | (WCELL(_,e1),SREF(id,e2)) => linkWREF(e1,e2,id,x,y)
123 :     | (SCELL(_,e1),SREF(_,e2)) => linky(e1,e2,x,y)
124 :    
125 :     | (WREF(_,e1), WCELL(_,e2)) => linkx(e1,e2,x,y)
126 :     | (SREF(_,e1), WCELL(id,e2)) => linkWREF(e1,e2,id,x,y)
127 :     | (WCELL(_,e1),WCELL(_,e2)) => linkx(e1,e2,x,y)
128 :     | (SCELL(_,e1),WCELL(_,e2)) => linky(e1,e2,x,y)
129 :    
130 :     | (WREF(_,e1), SCELL(_,e2)) => linkx(e1,e2,x,y)
131 :     | (SREF(_,e1), SCELL(_,e2)) => linkx(e1,e2,x,y)
132 :     | (WCELL(_,e1),SCELL(_,e2)) => linkx(e1,e2,x,y)
133 :     | (SCELL(_,e1),SCELL(_,e2)) => linkx(e1,e2,x,y)
134 : monnier 409 | _ => error "unify"
135 :     end
136 :    
137 :     and collapseAll([],_) = ()
138 :     | collapseAll((_,_,x)::xs,y) = (unify(x,y); collapseAll(xs,y))
139 :    
140 :     and unifyList(l1,l2) =
141 :     let fun merge([],l) = l
142 :     | merge(l,[]) = l
143 :     | merge(a as (c as (k,i,x))::u,b as (d as (k',i',y))::v) =
144 :     if k=k' andalso i=i' then (unify(x,y); c::merge(u,v))
145 : leunga 585 else if less(k,i,k',i') then d::merge(a,v) else c::merge(u,b)
146 : monnier 409 in merge(sort l1,sort l2) end
147 :    
148 :     fun pi(x,i) = getIth(PI,i,x)
149 :     fun dom(x,i) = getIth(DOM,i,x)
150 :     fun ran(x,i) = getIth(RAN,i,x)
151 : leunga 590 fun sub(x,i) = let val m = getIth(PI,i,x) in mut m; m end
152 : monnier 409
153 : leunga 585 fun offset(x,i) = (unify(x,newTop{mutable=false,name=""}); find x)
154 : monnier 409
155 :     and unifyAll(x,[]) = ()
156 :     | unifyAll(x,(_,_,y)::l) = (unify(x,y); unifyAll(x,l))
157 :    
158 : leunga 585 fun mkHeader(NONE,es) = es
159 :     | mkHeader(SOME h,es) = (PI,~1,h)::es
160 :    
161 :     fun mkAlloc(header, xs) =
162 : monnier 409 let fun collect(_,[],l) = l
163 :     | collect(i,x::xs,l) = collect(i+1,xs,(PI,i,x)::l)
164 : leunga 585 in (!newMem(), ref(mkHeader(header,collect(0,xs,[])))) end
165 : monnier 409
166 : leunga 585 fun mkRecord(header,xs) = ref(SCELL(mkAlloc(header, xs)))
167 :     fun mkRef(header,x) = ref(SREF(mkAlloc(header, [x])))
168 :     fun mkArray(header,xs) = ref(SREF(mkAlloc(header, xs)))
169 :     fun mkVector(header,xs) = ref(SCELL(mkAlloc(header, xs)))
170 :     fun mkLambda(xs) =
171 :     let fun collect(_,[],l) = l
172 :     | collect(i,x::xs,l) = collect(i+1,xs,(DOM,i,x)::l)
173 :     in ref(SCELL(!newMem(), ref(collect(0,xs,[])))) end
174 : monnier 409
175 :     fun app(f,xs) =
176 :     let fun loop(_,[]) = ()
177 :     | loop(i,x::xs) = (unify(dom(f,i),x); loop(i+1,xs))
178 :     in loop(0,xs) end
179 :    
180 :     fun ret(f,xs) =
181 :     let fun loop(_,[]) = ()
182 :     | loop(i,x::xs) = (unify(ran(f,i),x); loop(i+1,xs))
183 :     in loop(0,xs) end
184 :    
185 : leunga 585 fun strongUpdate(a,i,x) = unify(sub(a,i),x)
186 :     fun strongSubscript(a,i) = sub(a,i)
187 : leunga 590 fun weakUpdate(a,x) =
188 :     let val elem = sub(a, 0)
189 :     in weak elem; unify(elem, x) end
190 :     fun weakSubscript(a) =
191 :     let val elem = sub(a, 0)
192 :     in weak elem; elem end
193 : monnier 409
194 : leunga 585 fun interfere(x,y) = find x = find y
195 :    
196 : blume 1126 val maxLevels = MLRiscControl.mkInt ("points-to-show-max-levels",
197 :     "max # of level to show in pointsTo")
198 : leunga 590 val _ = maxLevels := 3
199 : leunga 585
200 : leunga 590 fun toString r = show(!r, !maxLevels)
201 : leunga 585
202 : leunga 590 and show(LINK x, lvl) = show(!x, lvl)
203 : leunga 744 | show(SREF(id,es), lvl) = "sref"^C.toString id^edges(es, lvl)
204 :     | show(WREF(id,es), lvl) = "wref"^C.toString id^edges(es, lvl)
205 :     | show(SCELL(id,es), lvl) = "s"^C.toString id^edges(es, lvl)
206 :     | show(WCELL(id,es), lvl) = "w"^C.toString id^edges(es, lvl)
207 :     | show(TOP{name="",mutable=true,id,...}, _) = "var"^C.toString id
208 :     | show(TOP{name="",mutable=false,id,...}, _) = "const"^C.toString id
209 : leunga 590 | show(TOP{name,...}, _) = name
210 : leunga 585
211 : leunga 590 and edges(es, ~1) = ""
212 :     | edges(es, lvl) =
213 :     let fun prInt i = if i < 0 then "-"^Int.toString(~i) else Int.toString i
214 :     fun add(a,"") = a
215 :     | add(a,b) = a^","^b
216 :     fun cnv((PI,i,x),s) = add(prInt i^"->"^show(!x, lvl-1),s)
217 :     | cnv(_,s) = s
218 :     in case foldr cnv "" (!es) of
219 :     "" => ""
220 :     | t => if lvl = 0 then "..." else "["^t^"]"
221 :     end
222 :    
223 : monnier 409 end

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