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/compiler/TopLevel/main/compile.sml
ViewVC logotype

Annotation of /sml/trunk/compiler/TopLevel/main/compile.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2492 - (view) (download)

1 : monnier 16 (* COPYRIGHT (c) 1996 Bell Laboratories *)
2 :     (* compile.sml *)
3 :    
4 :     functor CompileF(structure M : CODEGENERATOR
5 : blume 1078 structure CC : CCONFIG
6 :     val cproto_conv : string) : COMPILE0 =
7 : monnier 16 struct
8 :    
9 : blume 879 fun mkCompInfo { source, transform } =
10 :     CompInfo.mkCompInfo { source = source,
11 :     transform = transform,
12 :     mkMkStamp = CC.mkMkStamp }
13 : monnier 16
14 : blume 879 type pickle = CC.pickle (* pickled format *)
15 :     type hash = CC.hash (* environment hash id *)
16 : blume 1058 type pid = CC.pid
17 : blume 1137 type guid = CC.guid
18 : monnier 16
19 : blume 879 (*************************************************************************
20 :     * ELABORATION *
21 :     *************************************************************************)
22 : monnier 16
23 : blume 879 (** several preprocessing phases done after parsing or
24 :     ** after elaborations *)
25 :     (*
26 :     val fixityparse =
27 :     (* Stats.doPhase (Stats.makePhase "Compiler 005 fixityparse") *)
28 :     FixityParse.fixityparse
29 :     val lazycomp =
30 :     (* Stats.doPhase (Stats.makePhase "Compiler 006 lazycomp") *)
31 :     LazyComp.lazycomp
32 :     *)
33 :     val pickUnpick =
34 :     Stats.doPhase (Stats.makePhase "Compiler 036 pickunpick") CC.pickUnpick
35 : monnier 16
36 : blume 879 (** take ast, do semantic checks,
37 :     ** and output the new env, absyn and pickles *)
38 : blume 1137 fun elaborate {ast, statenv=senv, compInfo=cinfo, guid} = let
39 : monnier 16
40 : blume 879 val (absyn, nenv) = ElabTop.elabTop(ast, senv, cinfo)
41 :     val (absyn, nenv) =
42 :     if CompInfo.anyErrors cinfo then
43 :     (Absyn.SEQdec nil, StaticEnv.empty)
44 :     else (absyn, nenv)
45 : blume 1137 val { pid, pickle, exportLvars, exportPid, newenv } =
46 :     pickUnpick { context = senv, env = nenv, guid = guid }
47 : blume 879 in {absyn=absyn, newstatenv=newenv, exportPid=exportPid,
48 : blume 1137 exportLvars=exportLvars, staticPid = pid, pickle = pickle }
49 : blume 879 end (* function elaborate *)
50 : monnier 16
51 : blume 879 val elaborate =
52 :     Stats.doPhase(Stats.makePhase "Compiler 030 elaborate") elaborate
53 : monnier 16
54 : blume 879 (*************************************************************************
55 :     * ABSYN INSTRUMENTATION *
56 :     *************************************************************************)
57 : monnier 16
58 : blume 903 local
59 :     val isSpecial = let
60 :     val l = [SpecialSymbols.paramId,
61 :     SpecialSymbols.functorId,
62 :     SpecialSymbols.hiddenId,
63 :     SpecialSymbols.tempStrId,
64 :     SpecialSymbols.tempFctId,
65 :     SpecialSymbols.fctbodyId,
66 :     SpecialSymbols.anonfsigId,
67 :     SpecialSymbols.resultId,
68 :     SpecialSymbols.returnId,
69 :     SpecialSymbols.internalVarId]
70 :     in
71 :     fn s => List.exists (fn s' => Symbol.eq (s, s')) l
72 :     end
73 :     in
74 : blume 879 (** instrumenting the abstract syntax to do time- and space-profiling *)
75 :     fun instrument {source, senv, compInfo} =
76 :     SProf.instrumDec (senv, compInfo) source
77 : dbm 2492 o TProf.instrumDec PrimOpId.isPrimCallcc (senv, compInfo)
78 : mblume 1650 o TDPInstrument.instrument isSpecial (senv, compInfo)
79 : blume 903 end
80 : monnier 16
81 : blume 879 val instrument =
82 :     Stats.doPhase (Stats.makePhase "Compiler 039 instrument") instrument
83 : monnier 16
84 : blume 879 (*************************************************************************
85 :     * TRANSLATION INTO FLINT *
86 :     *************************************************************************)
87 : monnier 16
88 : blume 879 (** take the abstract syntax tree, generate the flint intermediate code *)
89 :     fun translate{absyn, exportLvars, newstatenv, oldstatenv, compInfo} =
90 :     (*** statenv used for printing Absyn in messages ***)
91 :     let val statenv = StaticEnv.atop (newstatenv, oldstatenv)
92 :     in
93 : blume 1078 Translate.transDec { rootdec = absyn,
94 :     exportLvars = exportLvars,
95 : dbm 2492 oldenv = oldstatenv,
96 :     env = statenv,
97 : blume 1078 cproto_conv = cproto_conv,
98 :     compInfo = compInfo }
99 : blume 879 end
100 : monnier 16
101 : blume 879 val translate =
102 :     Stats.doPhase (Stats.makePhase "Compiler 040 translate") translate
103 : monnier 16
104 :    
105 : blume 879 (*************************************************************************
106 :     * CODE GENERATION *
107 :     *************************************************************************)
108 : monnier 16
109 : blume 879 (** take the flint code and generate the machine binary code *)
110 :     local
111 :     val inline = LSplitInline.inline
112 :     val addCode = Stats.addStat (Stats.makeStat "Code Size")
113 :     in
114 :     fun codegen { flint, imports, symenv, splitting, compInfo } = let
115 :     (* hooks for cross-module inlining and specialization *)
116 :     val (flint, revisedImports) = inline (flint, imports, symenv)
117 : monnier 113
118 : blume 879 (* from optimized FLINT code, generate the machine code. *)
119 :     val (csegs,inlineExp) = M.flintcomp(flint, compInfo, splitting)
120 :     (* Obey the nosplit directive used during bootstrapping. *)
121 :     (* val inlineExp = if isSome splitting then inlineExp else NONE *)
122 :     val codeSz =
123 :     List.foldl
124 :     (fn (co, n) => n + CodeObj.size co)
125 :     (CodeObj.size(#c0 csegs) + Word8Vector.length(#data csegs))
126 : monnier 251 (#cn csegs)
127 : blume 879 in
128 :     addCode codeSz;
129 :     { csegments=csegs, inlineExp=inlineExp, imports = revisedImports }
130 :     end
131 :     end (* local codegen *)
132 : monnier 16
133 : blume 587 (*
134 : blume 879 val codegen =
135 :     Stats.doPhase (Stats.makePhase "Compiler 140 CodeGen") codegen
136 : blume 587 *)
137 : monnier 16
138 : blume 879 (*************************************************************************
139 :     * COMPILATION *
140 :     * = ELABORATION + TRANSLATION TO FLINT + CODE GENERATION *
141 :     * used by interact/evalloop.sml, cm/compile/compile.sml only *
142 :     *************************************************************************)
143 :     (** compiling the ast into the binary code = elab + translate + codegen *)
144 : blume 1058 fun compile {source, ast, statenv, symenv, compInfo=cinfo,
145 : blume 1137 checkErr=check, splitting, guid } =
146 : blume 1058 let val {absyn, newstatenv, exportLvars, exportPid,
147 : blume 1137 staticPid, pickle } =
148 : blume 1058 elaborate {ast=ast, statenv=statenv, compInfo=cinfo,
149 : blume 1137 guid = guid}
150 : blume 879 before (check "elaborate")
151 : monnier 16
152 : blume 879 val absyn = instrument {source=source, senv = statenv,
153 :     compInfo=cinfo} absyn
154 :     before (check "instrument")
155 : monnier 16
156 : blume 879 val {flint, imports} =
157 :     translate {absyn=absyn, exportLvars=exportLvars,
158 :     newstatenv=newstatenv, oldstatenv=statenv,
159 :     compInfo=cinfo}
160 :     before check "translate"
161 : monnier 16
162 : blume 879 val { csegments, inlineExp, imports = revisedImports } =
163 :     codegen { flint = flint, imports = imports, symenv = symenv,
164 :     splitting = splitting, compInfo = cinfo }
165 :     before (check "codegen")
166 :     (*
167 :     * interp mode was currently turned off.
168 :     *
169 :     * if !Control.interp then Interp.interp flint
170 :     * else codegen {flint=flint, splitting=splitting, compInfo=cinfo})
171 :     *)
172 :     in
173 :     { csegments = csegments,
174 :     newstatenv = newstatenv,
175 :     absyn = absyn,
176 :     exportPid = exportPid,
177 :     exportLvars = exportLvars,
178 :     staticPid = staticPid,
179 :     pickle = pickle,
180 :     inlineExp = inlineExp,
181 :     imports = revisedImports }
182 :     end (* function compile *)
183 : monnier 16 end (* functor CompileF *)

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