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

SCM Repository

[smlnj] Diff of /sml/trunk/compiler/FLINT/clos/closure.sml
 [smlnj] / sml / trunk / compiler / FLINT / clos / closure.sml

Diff of /sml/trunk/compiler/FLINT/clos/closure.sml

sml/branches/SMLNJ/src/compiler/FLINT/clos/closure.sml revision 245, Sat Apr 17 18:47:12 1999 UTC sml/trunk/compiler/FLINT/clos/closure.sml revision 2162, Thu Nov 2 21:20:47 2006 UTC
# Line 166  Line 166
167
168  (* sort according to each variable's life time etc. *)  (* sort according to each variable's life time etc. *)
169  fun sortlud0 x = Sort.sort (fn ((_,_,i : int),(_,_,j)) => (i>j)) x  fun sortlud0 x = ListMergeSort.sort (fn ((_,_,i : int),(_,_,j)) => (i>j)) x
170
171  fun sortlud1 x =  fun sortlud1 x =
172    let fun ludfud1((_,m:int,i:int),(_,n,j)) =    let fun ludfud1((_,m:int,i:int),(_,n,j)) =
173                      (i>j) orelse ((i=j) andalso (m>n))                      (i>j) orelse ((i=j) andalso (m>n))
174     in Sort.sort ludfud1 x     in ListMergeSort.sort ludfud1 x
175    end    end
176
177  fun sortlud2(l,vl) =  fun sortlud2(l,vl) =
# Line 181  Line 181
181                    (m>n) orelse ((m=n) andalso (v<w))                    (m>n) orelse ((m=n) andalso (v<w))
182
183        val nl = map (fn (u as (v,_,_)) => (u,h u,v)) l        val nl = map (fn (u as (v,_,_)) => (u,h u,v)) l
184     in map #1 (Sort.sort ludfud2 nl)     in map #1 (ListMergeSort.sort ludfud2 nl)
185    end    end
186
187  (* cut out the first n elements, returns both the header and the rest *)  (* cut out the first n elements, returns both the header and the rest *)
# Line 286  Line 286
286  abstype env = Env of lvar list *                  (* values *)  abstype env = Env of lvar list *                  (* values *)
287                       (lvar * closureRep) list *   (* closures *)                       (lvar * closureRep) list *   (* closures *)
288                       lvar list *                  (* disposable cells *)                       lvar list *                  (* disposable cells *)
289                       object Intmap.intmap         (* what map *)                       object IntHashTable.hash_table (* what map *)
290  with  with
291
292  (****************************************************************************  (****************************************************************************
# Line 294  Line 294
294   ****************************************************************************)   ****************************************************************************)
295
296  exception NotBound  exception NotBound
297  fun emptyEnv() = Env([],[],[],Intmap.new(32,NotBound))  fun emptyEnv() = Env([],[],[],IntHashTable.mkTable(32,NotBound))
298
299  (* add a new object to an environment *)  (* add a new object to an environment *)
300  fun augment(m as (v,obj),e as Env(valueL,closureL,dispL,whatMap)) =  fun augment(m as (v,obj),e as Env(valueL,closureL,dispL,whatMap)) =
301    (Intmap.add whatMap m;    (IntHashTable.insert whatMap m;
302     case obj     case obj
303      of Value _ => Env(v::valueL,closureL,dispL,whatMap)      of Value _ => Env(v::valueL,closureL,dispL,whatMap)
304       | Closure cr => Env(valueL,(v,cr)::closureL,dispL,whatMap)       | Closure cr => Env(valueL,(v,cr)::closureL,dispL,whatMap)
# Line 393  Line 393
393    in  pr "Values:"; ilist valueL;    in  pr "Values:"; ilist valueL;
394        pr "Closures:\n"; p(fn () => (),closureL,nil);        pr "Closures:\n"; p(fn () => (),closureL,nil);
395        pr "Disposable records:\n"; ilist dispL;        pr "Disposable records:\n"; ilist dispL;
396        pr "Known function mapping:\n"; Intmap.app fp whatMap;        pr "Known function mapping:\n"; IntHashTable.appi fp whatMap;
397        pr "Callee-save continuation mapping:\n";        pr "Callee-save continuation mapping:\n";
398        Intmap.app cp whatMap        IntHashTable.appi cp whatMap
399    end    end
400
401  (****************************************************************************  (****************************************************************************
# Line 404  Line 404
404
405  exception Lookup of lvar * env  exception Lookup of lvar * env
406  fun whatIs(env as Env(_,_,_,whatMap),v) =  fun whatIs(env as Env(_,_,_,whatMap),v) =
407    Intmap.map whatMap v handle NotBound => raise Lookup(v,env)    IntHashTable.lookup whatMap v handle NotBound => raise Lookup(v,env)
408
409  (* Add v to the access environment, v must be in whatMap already *)  (* Add v to the access environment, v must be in whatMap already *)
410  fun augvar(v,e as Env(valueL,closureL,dispL,whatMap)) =  fun augvar(v,e as Env(valueL,closureL,dispL,whatMap)) =
# Line 1021  Line 1021
1021               | SOME v => (enter(v,t),b))               | SOME v => (enter(v,t),b))
1022
1023        (* process the rest groups in free *)        (* process the rest groups in free *)
1024        fun h([],i,r,t,b) = m(r,t,b)        fun h([],i:int,r,t,b) = m(r,t,b)
1025          | h((v,_,j)::z,i,r,t,b) =          | h((v,_,j)::z,i,r,t,b) =
1026              if j = i then h(z,i,enter(v,r),t,b)              if j = i then h(z,i,enter(v,r),t,b)
1027              else let val (nt,nb) = m(r,t,b)              else let val (nt,nb) = m(r,t,b)
# Line 1123  Line 1123
1123                    in if len < limit then m(y,s,r,k)                    in if len < limit then m(y,s,r,k)
1125                   end)                   end)
1126        val clist = Sort.sort worse (foldr h [] closlist)        val clist = ListMergeSort.sort worse (foldr h [] closlist)
1127     in m(clist,[],vfree,vlen)     in m(clist,[],vfree,vlen)
1128    end    end
1129
# Line 1464  Line 1464
1464
1465          (* for recursive functions, always spill deeper level free variables *)          (* for recursive functions, always spill deeper level free variables *)
1466          val ((gpspill,gpfree),(fpspill,fpfree),nflag) = case lpv          val ((gpspill,gpfree),(fpspill,fpfree),nflag) = case lpv
1467            of SOME _ => (partition deep1 gpfree,partition deep1 fpfree,true)            of SOME _ =>
1468                   let fun h((v,_,_),l) =
1469                         case whatIs(initEnv,v)
1470                          of (Closure (CR(_,{free,...}))) => merge(rmv(v,free),l)
1471                           | _ => l
1472                       val gpfree = removeV(foldr h [] gpfree, gpfree)
1473                       val gpfreePart =
1474                             if length(gpfree) < numCSgpregs
1475                             then ([],gpfree)
1476                             else partition deep1 gpfree
1477                    in (gpfreePart, partition deep1 fpfree,true)
1478                   end
1479             | NONE => if ekfuns v then ((gpfree,[]),(fpfree,[]),flag)             | NONE => if ekfuns v then ((gpfree,[]),(fpfree,[]),flag)
1480                       else (partition deep2 gpfree,partition deep2 fpfree,flag)                       else (partition deep2 gpfree,partition deep2 fpfree,flag)
1481
# Line 2022  Line 2033
2033             val ne = close(e,augValue(w,t,env),sn,csg,csf,ret)             val ne = close(e,augValue(w,t,env),sn,csg,csf,ret)
2035         end         end
2036        | RCC(k,l,p,args,wtl,e) =>
2037           let val (env,header) = fixAccess(args,env)
2038               val ne = close(e,foldl (fn((w, t), env) =>
2039                                         augValue(w,t,env)) env wtl,
2040                              sn,csg,csf,ret)
2042           end
2043
2044  (***************************************************************************  (***************************************************************************
2045   * Calling the "close" on the CPS expression with proper initializations   *   * Calling the "close" on the CPS expression with proper initializations   *
# Line 2045  Line 2063
2063  end (* functor Closure *)  end (* functor Closure *)
2064
2065
(*
* \$Log\$
*)

Legend:
 Removed from v.245 changed lines Added in v.2162