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

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