Return to cpscomp.sml CVS log

Up to [Research Unix] / researchv10no / cmd / sml / src / cps

Annotation of researchv10no/cmd/sml/src/cps/cpscomp.sml, revision 1.1.1.1

1.1       root        1: (* Copyright 1989 by AT&T Bell Laboratories *)
                      2: functor CPScomp(CM : CMACHINE) : 
                      3:                sig val compile : Lambda.lexp -> unit end =
                      4: struct
                      5: 
                      6: structure CPSg = CPSgen(CM)
                      7: structure CPSopt = CPSopt(val maxfree = 3+length(CM.miscregs))
                      8: structure Closure = Closure(val maxfree = 3+length(CM.miscregs))
                      9: structure Spill = Spill(val maxfree = 3+length(CM.miscregs))
                     10: 
                     11: open ErrorMsg Access Basics BareAbsyn ProcessFile
                     12: 
                     13:  val write = CM.comment
                     14: 
                     15:  fun time (f,m,s) x =
                     16:         let val _ = debugmsg m
                     17:            val t = System.Timer.start_timer()
                     18:             val r = f x
                     19:            val t' = System.Timer.check_timer t
                     20:             val _ = (write "After "; write m; write ":\n")
                     21:         in  System.Stats.update(s,t');
                     22:            timemsg(m ^ ": " ^ System.Timer.makestring t' ^ "s");
                     23:            flush_out(std_out);
                     24:            r
                     25:         end
                     26: 
                     27: fun compile lexp =
                     28:  let
                     29:   val reorder = time(Reorder.reorder,"reorder",System.Stats.codeopt)
                     30:   val lexp = reorder lexp
                     31: 
                     32:   val convert   = time(Convert.convert,"convert",System.Stats.convert)
                     33:   val (function, ctable) = convert lexp
                     34:   fun fprint (function as (f,vl,cps)) =
                     35:          (if !System.Control.CG.printit
                     36:                then CPSprint.show write (Intmap.map ctable)
                     37:                                (CPS.FIX([function],CPS.PRIMOP(P.+,[],[],[])))
                     38:                else ();
                     39:           if !System.Control.CG.printsize then CPSsize.printsize cps else ())
                     40:   val _ = fprint function;
                     41: 
                     42:   val cpsopt = time(CPSopt.reduce ctable,"cpsopt",System.Stats.cpsopt)
                     43:   val function = let val (f,vl,cps) = function in (f,vl, cpsopt cps) end
                     44:   fun newconst c = let val v = mkLvar()
                     45:                    in  Intmap.add ctable (v,CPS.INTconst c); v
                     46:                   end
                     47:   fun prof(a,b,ce) = CPS.PRIMOP(P.profile, [newconst a,newconst b],nil,[ce])
                     48:   val ctable = Intmap.map ctable
                     49:   val constant = fn w => ((ctable w; true) handle Ctable => false)
                     50:   val _ = fprint function
                     51: 
                     52:   val closure   = time(Closure.closeCPS,"closure",System.Stats.closure)
                     53:   val (function,known,unknown) = closure(function,constant,prof)
                     54:   val constant = fn w => constant w orelse known w orelse unknown w
                     55:   val _ = fprint function
                     56: 
                     57:   val globalfix = time(GlobalFix.globalfix,"globalfix",System.Stats.globalfix)
                     58:   val carg = globalfix(function,known)
                     59:   val _ = app fprint (map #1 carg)
                     60: 
                     61:   val spill     = time(Spill.spill,"spill",System.Stats.spill)
                     62:   val constant' = let val s = Intset.new()
                     63:                      val _ = app (Intset.add s o #1 o #1) carg
                     64:                      val isfun = Intset.mem s
                     65:                   in fn v => constant v orelse isfun v
                     66:                  end
                     67:   val carg = spill(carg,constant',prof)
                     68:   val _ = (app fprint (map #1 carg); write "\n")
                     69: 
                     70:   val codegen   = time(CPSg.codegen,"codegen",System.Stats.codegen)
                     71:   val _ = codegen(carg,ctable,constant')
                     72:   val _ = debugmsg "done"
                     73:   in ()
                     74:  end
                     75: end (* functor CPScomp *)

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.