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/src/compiler/FLINT/main/flintcomp.sml
[smlnj] / sml / trunk / src / compiler / FLINT / main / flintcomp.sml  
ViewVC logotype

Diff of /sml/trunk/src/compiler/FLINT/main/flintcomp.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 220, Tue Mar 9 02:15:05 1999 UTC revision 251, Mon Apr 19 02:55:26 1999 UTC
# Line 1  Line 1 
1  (* COPYRIGHT (c) 1998 YALE FLINT PROJECT *)  (* COPYRIGHT (c) 1998 YALE FLINT PROJECT *)
2  (* flintcomp.sml *)  (* flintcomp.sml *)
3    
4  functor FLINTComp (structure Gen: CPSGEN  functor FLINTComp (structure Gen: MACHINE_GEN
5                     val collect: unit -> Word8Vector.vector) : CODEGENERATOR =                     val collect: unit -> CodeObj.code_object) : CODEGENERATOR =
6  struct  struct
7    
8  local structure CB = CompBasic  local structure CB = CompBasic
# Line 12  Line 12 
12        structure CPStrans = CPStrans(MachSpec)        structure CPStrans = CPStrans(MachSpec)
13        structure CPSopt = CPSopt(MachSpec)        structure CPSopt = CPSopt(MachSpec)
14        structure Closure = Closure(MachSpec)        structure Closure = Closure(MachSpec)
15        structure Spill = Spill(MachSpec)        structure Spill = SpillFn(MachSpec)
16        structure CpsSplit = CpsSplitFun (MachSpec)        structure CpsSplit = CpsSplitFun (MachSpec)
17        structure CTRL = FLINT_Control        structure CTRL = FLINT_Control
18        structure PP = PPFlint        structure PP = PPFlint
# Line 21  Line 21 
21        structure F  = FLINT        structure F  = FLINT
22  in  in
23    
24    structure Machine = Gen
25  val architecture = Gen.MachSpec.architecture  val architecture = Gen.MachSpec.architecture
26  fun bug s = ErrorMsg.impossible ("FLINTComp:" ^ s)  fun bug s = ErrorMsg.impossible ("FLINTComp:" ^ s)
27  val say = Control_Print.say  val say = Control_Print.say
# Line 54  Line 55 
55  val cpstrans  = phase "Compiler 065 cpstrans" CPStrans.cpstrans  val cpstrans  = phase "Compiler 065 cpstrans" CPStrans.cpstrans
56  val cpsopt    = phase "Compiler 070 cpsopt" CPSopt.reduce  val cpsopt    = phase "Compiler 070 cpsopt" CPSopt.reduce
57  val litsplit  = phase "Compiler 075 litsplit" Literals.litsplit  val litsplit  = phase "Compiler 075 litsplit" Literals.litsplit
58  val lit2cps   = phase "Compiler 076 lit2cps" Literals.lit2cps  val litToBytes = phase "Compiler 076 litToBytes" Literals.litToBytes
59  val closure   = phase "Compiler 080 closure"  Closure.closeCPS  val closure   = phase "Compiler 080 closure"  Closure.closeCPS
60  val globalfix = phase "Compiler 090 globalfix" GlobalFix.globalfix  val globalfix = phase "Compiler 090 globalfix" GlobalFix.globalfix
61  val spill     = if MachSpec.spillAreaSz < 500 * MachSpec.valueSize  val spill     = phase "Compiler 100 spill" Spill.spill
                 then phase "Compiler 100 spill" Spill.spill  
                 else fn x => x  
62  val limit     = phase "Compiler 110 limit" Limit.nolimit  val limit     = phase "Compiler 110 limit" Limit.nolimit
63  val codegen   = phase "Compiler 120 cpsgen" Gen.codegen  val codegen   = phase "Compiler 120 cpsgen" Gen.codegen
64    
 val closureD  = phase "Compiler 081 closureD"  Closure.closeCPS  
 val globalfixD= phase "Compiler 091 globalfixD" GlobalFix.globalfix  
 val spillD    = if MachSpec.spillAreaSz < 500 * MachSpec.valueSize  
                 then phase "Compiler 101 spillD" Spill.spill  
                 else fn x => x  
 val limitD    = phase "Compiler 110 limitD" Limit.nolimit  
 val codegenD  = phase "Compiler 121 cpsgenD" Gen.codegen  
   
65  (** pretty printing for the FLINT and CPS code *)  (** pretty printing for the FLINT and CPS code *)
66  val (prF, prC) =  val (prF, prC) =
67    let fun prGen (flag,printE) s e =    let fun prGen (flag,printE) s e =
# Line 204  Line 195 
195              val _ = prC "cpsopt" function              val _ = prC "cpsopt" function
196    
197              val (function, dlit) = litsplit function              val (function, dlit) = litsplit function
198              val data = lit2cps dlit              val data = litToBytes dlit
199              val _ = prC "cpsopt-code" function              val _ = prC "cpsopt-code" function
             val _ = prC "cpsopt-data" data  
200    
201    (** NOTE: we should be passing the source-code name (src) to the
202     ** code generator somehow (for the second argument to code object allocation).
203     **)
204              fun gen fx =              fun gen fx =
205                let val fx = (prC "closure" o closure) fx                let val fx = (prC "closure" o closure) fx
206                    val carg = globalfix fx                    val carg = globalfix fx
# Line 217  Line 210 
210                    collect ()                    collect ()
211                end                end
212    
             fun gdata dd =  
               let val x = Control.CG.printit  
                   val y = !x  
                   val _ = (x := false)  
                   val fx = (prC "closure" o closureD) dd  
                   val carg = globalfixD fx  
                   val carg = spillD carg  
                   val (carg, limit) = limitD carg  
                in codegenD (carg, limit, err);  
                   (collect ()) before (x := y)  
               end  
213           in case CpsSplit.cpsSplit function           in case CpsSplit.cpsSplit function
214               of (fun0 :: funn) => (gen fun0, map gen funn, gdata data)               of (fun0 :: funn) => (gen fun0, map gen funn, data)
215                | [] => bug "unexpected case on gen in flintcomp"                | [] => bug "unexpected case on gen in flintcomp"
216          end          end
217     in ({c0=nc0, cn=ncn, data=dseg, name=ref (SOME src)}, fi)     in ({c0=nc0, cn=ncn, data=dseg}, fi)
218    end (* function flintcomp *)    end (* function flintcomp *)
219    
220  val flintcomp = phase "Compiler 050 flintcomp" flintcomp  val flintcomp = phase "Compiler 050 flintcomp" flintcomp
# Line 241  Line 223 
223  end (* structure FLINTComp *)  end (* structure FLINTComp *)
224    
225  (*  (*
226   * $Log$   * $Log: flintcomp.sml,v $
227     * Revision 1.8  1999/01/11 16:53:25  george
228     *   new array representation support
229     *
230   *)   *)
Legend:
Removed from v.220  
changed lines
  Added in v.251
root@smlnj-gforge.cs.uchicago.edu
 ViewVC Help
Powered by ViewVC 1.0.0  
Powered By FusionForge