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     ! 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.