SCM Repository

[smlnj] Diff of /sml/trunk/src/compiler/FLINT/opt/fixfix.sml

[smlnj] / sml / trunk / src / compiler / FLINT / opt / fixfix.sml

Diff of /sml/trunk/src/compiler/FLINT/opt/fixfix.sml

-revision 212, Fri Jan 15 16:19:21 1999 UTC
+revision 213, Fri Jan 15 21:18:35 1999 UTC
 Line 51
  end
  structure SCC = SCCUtilFun (structure Node = SccNode)
+ datatype info = Fun of int ref
+               | Arg of int * (int * int) ref
  (* fexp: int ref intmapf -> lexp) -> (int * intset * lexp)
   * The intmap contains refs to counters.  The meaning of the counters
   * is slightly overloaded:
-Line 68
+Line 71
   *   which are assumed to be the freevars of the continuation of lexp)
   * - a new lexp with FIXes rewritten.
   *)
- fun fexp mf lexp = let
+ fun fexp mf depth lexp = let
-     val loop = fexp mf
+     val loop = fexp mf depth
      fun lookup (F.VAR lv) = M.lookup mf lv
        | lookup _ = raise M.IntmapF
-Line 188
+Line 191
             (* create call-counters for each fun and add them to fm *)
             val (fs,mf) = foldl (fn ((fk,f,args,body),(fs,mf)) =>
-                                 let val c = ref ~1
+                                 let val c = ref 0
-                                 in ((fk,f,args,body,c)::fs, M.add(mf, f, ref 0))
+                                 in ((fk, f, args, body, c)::fs,
+                                     M.add(mf, f, Fun c))
                                  end)
                                 ([],mf)
                                 fdecs
-Line 203
+Line 207
                     let val ((fk,f,fargs,fbody),(fk',f',fargs',fbody')) =
                             uncurry(args,body)
                         (* add the wrapper function *)
-                        val cs = map (fn _ => ref 0) fargs
+                        val cs = map (fn _ => ref(0,0)) fargs
                         val nm = M.add(m, f, ([f'], 1, fk, fargs, fbody, cf, cs))
                     (* now, retry ffun with the uncurried function *)
                     in ffun((fk', f', fargs', fbody', ref 1),
                             (s+1, fv, S.add(f', funs), nm))
                     end
                   | _ => (* non-curried function *)
-                    let val (mf,cs) = foldr (fn ((v,t),(m,cs)) =>
+                    let val newdepth =
-                                             let val c = ref 0
+                            case isrec
-                                             in (M.add(m, v, c), c::cs) end)
+                             of SOME(_,(F.LK_TAIL | F.LK_LOOP)) => depth + 1
+                              | _ => depth
+                        val (mf,cs) = foldr (fn ((v,t),(m,cs)) =>
+                                             let val c = ref(0, 0)
+                                             in (M.add(m, v, Arg(newdepth, c)),
+                                                 c::cs) end)
                                             (mf,[]) args
-                        val (fs,ffv,body) = fexp mf body
+                        val (fs,ffv,body) = fexp mf newdepth body
                         val ffv = rmvs(ffv, map #1 args) (* fun's freevars *)
                         val ifv = S.inter(ffv, funs) (* set of rec funs ref'ed *)
-                        val fs = fs div (case isrec of SOME(_,F.LK_TAIL) => 3
-                                                     | SOME(_,F.LK_LOOP) => 1
-                                                     | _ => 1)
                     in
                         (fs + s, S.union(ffv, fv), funs,
                          M.add(m, f, (S.members ifv, fs, fk, args, body, cf, cs)))
-Line 230
+Line 236
              * includes freevars of the continuation, but the uniqueness
              * of varnames ensures that S.inter(fv, funs) gives the correct
              * result nonetheless. *)
-            val (s,fv,le) = fexp mf le
+            val (s,fv,le) = fexp mf depth le
             val lename = LambdaVar.mkLvar()
             val m = M.singleton(lename, (S.members(S.inter(fv, funs)), 0,
                                          {inline=F.IH_SAFE, isrec=NONE,
-Line 249
+Line 255
                     val ilthreshold = !CTRL.inlineThreshold + (length args)
                     val ilh =
                         if inline = F.IH_ALWAYS then inline
-                        else if s < ilthreshold then F.IH_ALWAYS
+                        (* else if s < ilthreshold then F.IH_ALWAYS *)
-                        else let val cs = map (op!) cs
+                        else let val cs = map (fn ref(sp,ti) => sp + ti div 2) cs
                                  val s' = foldl (op+) 0 cs
                         in if s < 2*s' + ilthreshold
-                           then ((* say((Collect.LVarString f)^" = F.IH_MAYBE "^(Int.toString (s-ilthreshold))^(foldl (fn (i,s) => s^" "^(Int.toString i)) "" cs)^"\n"); *)
+                           then ((* say((Collect.LVarString f)^" = F.IH_MAYBE "^
+                                     (Int.toString (s-ilthreshold))^
+                                     (foldl (fn (i,s) => s^" "^
+                                             (Int.toString i))
+                                      "" cs)^"\n"); *)
                                  F.IH_MAYBE (s-ilthreshold, cs))
                            else inline
                         end
-Line 290
+Line 300
         (* For known functions, increase the counter and
          * make the call a bit cheaper. *)
         let val scall =
-                (let val cf as ref c = M.lookup mf f
+                (case M.lookup mf f
-                in if c < 0
+                  of Fun(fc as ref c) => (fc := c + 1; 1)
-                   then (cf := c - 1; 1)
+                   | Arg(d, ac as ref (sp,ti)) =>
-                   else (cf := c + 5; 5)
+                     (ac := (4 + sp, OU.pow2(depth - d) * 30 + ti); 5))
-                end) handle M.IntmapF => 5
+                    handle M.IntmapF => 5
         in
             (scall + (length args), addvs(S.singleton f, args), lexp)
         end
-Line 318
+Line 328
                 end
               | farm (dc,le) =
                 let val (s,fv,le) = loop le in (s, fv, (dc, le)) end
+            val narms = length arms
             val (s,smax,fv,arms) =
                 foldl (fn ((s1,fv1,arm),(s2,smax,fv2,arms)) =>
                        (s1+s2, Int.max(s1,smax), S.union(fv1, fv2), arm::arms))
-                      (0, 0, S.empty, []) (map farm arms)
+                      (narms, 0, S.empty, []) (map farm arms)
-        in  let val cf = lookup v in cf := !cf+s-smax end handle M.IntmapF=>();
+        in (case lookup v
+             of Arg(d,ac as ref(sp,ti)) =>
+                ac := (sp + s - smax + narms, OU.pow2(depth - d) * 2 + ti)
+              | _ => ()) handle M.IntmapF => ();
             case def
             of NONE => (s, fv, F.SWITCH(v, ac, arms, NONE))
              | SOME le => let val (sd,fvd,le) = loop le
-Line 339
+Line 353
         end
       | F.SELECT (v,i,lv,le) =>
         let val (s,fv,le) = loop le
-        in let val cf = lookup v in cf := !cf + 1 end handle M.IntmapF=>();
+        in (case lookup v
+             of Arg(d,ac as ref(sp,ti)) =>
+                ac := (sp + 1, OU.pow2(depth - d) + ti)
+              | _ => ()) handle M.IntmapF=>();
             (1+s, addv(S.rmv(lv, fv), v), F.SELECT(v,i,lv,le))
         end
       | F.RAISE (F.VAR v,ltys) => (3, S.singleton v, lexp)
-Line 364
+Line 381
  end
  fun fixfix ((fk,f,args,body):F.prog) =
-     let val (s,fv,nbody) = fexp M.empty body
+     let val (s,fv,nbody) = fexp M.empty 0 body
          val fv = S.diff(fv, S.make(map #1 args))
      in
          (*  PPFlint.printLexp(F.RET(map F.VAR (S.members fv))); *)

 Legend:



Removed from v.212
 


changed lines


 
Added in v.213
 Legend:



Removed from v.212
 


changed lines


 
Added in v.213
-Removed from v.212
+Added in v.213

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