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

SCM Repository

[smlnj] Annotation of /sml/trunk/src/compiler/FLINT/main/flintcomp.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 118 - (view) (download)

1 : monnier 16 (* COPYRIGHT (c) 1998 YALE FLINT PROJECT *)
2 :     (* flintcomp.sml *)
3 :    
4 :     functor FLINTComp (structure Gen: CPSGEN
5 :     val collect: unit -> Word8Vector.vector) : CODEGENERATOR =
6 :     struct
7 :    
8 :     local structure CB = CompBasic
9 :     structure CGC = Control.CG
10 :     structure MachSpec = Gen.MachSpec
11 :     structure Convert = Convert(MachSpec)
12 :     structure CPStrans = CPStrans(MachSpec)
13 :     structure CPSopt = CPSopt(MachSpec)
14 : monnier 102 structure Closure = Closure(MachSpec)
15 : monnier 16 structure Spill = Spill(MachSpec)
16 :     structure CpsSplit = CpsSplitFun (MachSpec)
17 :     in
18 :    
19 :     val architecture = Gen.MachSpec.architecture
20 :     fun bug s = ErrorMsg.impossible ("FLINTComp:" ^ s)
21 :     val say = Control.Print.say
22 :    
23 :     fun phase x = Stats.doPhase (Stats.makePhase x)
24 :    
25 : monnier 71 val lcontract = phase "Compiler 052 lcontract" LContract.lcontract
26 :     val specialize= phase "Compiler 053 specialize" Specialize.specialize
27 :     val wrapping = phase "Compiler 054 wrapping" Wrapping.wrapping
28 :     val reify = phase "Compiler 055 reify" Reify.reify
29 : monnier 16 (* val lambdaopt = phase "Compiler 057 lambdaopt" LContract.lcontract *)
30 :    
31 : monnier 71 val convert = phase "Compiler 060 convert" Convert.convert
32 :     val cpstrans = phase "Compiler 065 cpstrans" CPStrans.cpstrans
33 : monnier 16 val cpsopt = phase "Compiler 070 cpsopt" CPSopt.reduce
34 : monnier 102 val litsplit = phase "Compiler 075 litsplit" Literals.litsplit
35 :     val lit2cps = phase "Compiler 076 lit2cps" Literals.lit2cps
36 :     val closure = phase "Compiler 080 closure" Closure.closeCPS
37 : monnier 16 val globalfix = phase "Compiler 090 globalfix" GlobalFix.globalfix
38 :     val spill = if MachSpec.spillAreaSz < 500 * MachSpec.valueSize
39 :     then phase "Compiler 100 spill" Spill.spill
40 :     else fn x => x
41 :     val limit = phase "Compiler 110 limit" Limit.nolimit
42 :     val codegen = phase "Compiler 120 cpsgen" Gen.codegen
43 :    
44 : monnier 102 val closureD = phase "Compiler 081 closureD" Closure.closeCPS
45 :     val globalfixD= phase "Compiler 091 globalfixD" GlobalFix.globalfix
46 :     val spillD = if MachSpec.spillAreaSz < 500 * MachSpec.valueSize
47 :     then phase "Compiler 101 spillD" Spill.spill
48 :     else fn x => x
49 :     val limitD = phase "Compiler 110 limitD" Limit.nolimit
50 :     val codegenD = phase "Compiler 121 cpsgenD" Gen.codegen
51 : monnier 16
52 : monnier 71 (** pretty printing for the FLINT and CPS code *)
53 :     val (prF, prC) =
54 :     let fun prGen (flag,printE) s e =
55 : monnier 102 if !flag then (say ("\n[After " ^ s ^ " ...]\n\n"); printE e;
56 :     say "\n"; e)
57 : monnier 71 else e
58 :     in (prGen (CGC.printFlint, PPFlint.printProg),
59 :     prGen (CGC.printit, PPCps.printcps0))
60 :     end
61 : monnier 16
62 : monnier 71 (** writing out a term into a error output file *)
63 :     fun dumpTerm (printE, s, le) =
64 :     let val outS = TextIO.openAppend s;
65 :     val saveOut = !Control.Print.out
66 :     fun done () =
67 :     (TextIO.closeOut outS; Control.Print.out := saveOut)
68 :     in Control.Print.out := {say = fn s => TextIO.output(outS,s),
69 :     flush = fn () => TextIO.flushOut outS};
70 :     printE le handle x => (done () handle _ => (); raise x);
71 :     done ()
72 :     end (* function dumpTerm *)
73 :    
74 : monnier 16 (** compiling FLINT code into the binary machine code *)
75 :     fun flintcomp(flint, compInfo as {error, sourceName=src, ...}: CB.compInfo) =
76 :     let fun err severity s =
77 :     error (0,0) severity (concat["Real constant out of range: ",s,"\n"])
78 :    
79 :     fun check (checkE,printE,chkId) (enableChk,lvl,logId) e =
80 :     (if !enableChk andalso checkE (e,lvl) then
81 : monnier 71 (dumpTerm (printE, src ^ "." ^ chkId ^ logId, e);
82 :     bug (chkId ^ " typing errors " ^ logId))
83 : monnier 16 else ();
84 :     e)
85 : monnier 71 fun chkF (b, s) =
86 :     check (ChkFlint.checkTop, PPFlint.printFundec,
87 :     "FLINT") (CGC.checkFlint, b, s)
88 : monnier 16
89 : monnier 102 val _ = (chkF (false,"1") o prF "Translation/Normalization") flint
90 : monnier 71 val flint = (chkF (false,"2") o prF "Lcontract" o lcontract) flint
91 : monnier 16 val flint =
92 :     if !CGC.specialize then
93 : monnier 71 (chkF (false,"3") o prF "Specialization" o specialize) flint
94 : monnier 16 else flint
95 :    
96 : monnier 71 val flint = (chkF (false, "4") o prF "Wrapping" o wrapping) flint
97 :     val flint = (chkF (true, "5") o prF "Reify" o reify) flint
98 : monnier 102
99 :     val (nc0, ncn, dseg) =
100 :     let val function = convert flint
101 :     val _ = prC "convert" function
102 : monnier 71 val function = (prC "cpstrans" o cpstrans) function
103 : monnier 102 val function =
104 :     if !CGC.cpsopt then cpsopt (function,NONE,false)
105 :     else function
106 : monnier 71 val _ = prC "cpsopt" function
107 : monnier 45
108 : monnier 102 val (function, dlit) = litsplit function
109 :     val data = lit2cps dlit
110 :     val _ = prC "cpsopt-code" function
111 :     val _ = prC "cpsopt-data" data
112 :    
113 : monnier 71 fun gen fx =
114 :     let val fx = (prC "closure" o closure) fx
115 :     val carg = globalfix fx
116 :     val carg = spill carg
117 :     val (carg, limit) = limit carg
118 :     in codegen (carg, limit, err);
119 :     collect ()
120 :     end
121 : monnier 102
122 :     fun gdata dd =
123 :     let val x = Control.CG.printit
124 :     val y = !x
125 :     val _ = (x := false)
126 :     val fx = (prC "closure" o closureD) dd
127 :     val carg = globalfixD fx
128 :     val carg = spillD carg
129 :     val (carg, limit) = limitD carg
130 :     in codegenD (carg, limit, err);
131 :     (collect ()) before (x := y)
132 :     end
133 : monnier 71 in case CpsSplit.cpsSplit function
134 : monnier 102 of (fun0 :: funn) => (gen fun0, map gen funn, gdata data)
135 : monnier 71 | [] => bug "unexpected case on gen in flintcomp"
136 :     end
137 : monnier 102 in {c0=nc0, cn=ncn, data=dseg, name=ref (SOME src)}
138 : monnier 16 end (* function flintcomp *)
139 :    
140 : monnier 71 val flintcomp = phase "Compiler 050 flintcomp" flintcomp
141 : monnier 16
142 :     end (* local *)
143 :     end (* structure FLINTComp *)
144 : monnier 95
145 :     (*
146 : monnier 118 * $Log$
147 : monnier 95 *)

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