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

Diff of /sml/trunk/src/compiler/TopLevel/main/compile.sml

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

revision 878, Wed Jul 18 17:43:27 2001 UTC revision 879, Thu Jul 19 18:59:38 2001 UTC
# Line 5  Line 5 
5                   structure CC : CCONFIG) : COMPILE0 =                   structure CC : CCONFIG) : COMPILE0 =
6  struct  struct
7    
8  local structure FE = FrontEnd      fun mkCompInfo { source, transform } =
9        structure PS = PersStamps          CompInfo.mkCompInfo { source = source,
10        structure EM = ErrorMsg                                transform = transform,
11        structure SE = StaticEnv                                mkMkStamp = CC.mkMkStamp }
       structure DE = DynamicEnv  
       structure A  = Absyn  
       structure DA = Access  
       structure CB = CompBasic  
       structure ST = Stats  
       structure Obj = Unsafe.Object  
       structure W8V = Word8Vector  
 in  
   
 val say = Control_Print.say  
 fun bug s = EM.impossible ("Compile:" ^ s)  
12    
 exception Compile = SmlFile.Compile     (* raised during compilation only *)  
 exception SilentException = CC.SilentException     (* raised by CM *)  
 exception TopLevelException of exn     (* raised during executation only *)  
 exception TopLevelCallcc               (* raised during executation only *)  
 val architecture = M.architecture      (* machine architecture *)  
   
 (** important intermediate formats used during the compilations *)  
 type source     = CB.source            (* the input file *)  
 type ast        = CB.ast               (* concrete syntax *)  
 type absyn      = CB.absyn             (* abstract syntax *)  
 type flint      = CB.flint             (* intermediate code *)  
 type csegments  = CB.csegments         (* binary code segments *)  
 type executable = CB.executable        (* machine executables *)  
 type object     = CB.object            (* runtime object *)  
   
 (** environments and contexts used during the compilation *)  
 type statenv    = SE.staticEnv         (* static env   : symbol -> binding *)  
 type dynenv     = DE.dynenv    (* dynamic env  : pid -> object *)  
 type symenv     = SymbolicEnv.symenv   (* symbolic env : pid -> flint *)  
   
 type compInfo   = CB.compInfo          (* general compilation utilities *)  
 fun mkCompInfo (s, tr)  = CB.mkCompInfo (s, tr, CC.mkMkStamp)  
 val anyErrors   = CB.anyErrors  
   
 type lvar       = DA.lvar              (* local id *)  
 type pid        = PS.persstamp         (* persistant id *)  
 type import     = pid * CB.importTree  (* import specification *)  
13  type pickle     = CC.pickle            (* pickled format *)  type pickle     = CC.pickle            (* pickled format *)
14  type hash       = CC.hash              (* environment hash id *)  type hash       = CC.hash              (* environment hash id *)
15    
16  fun fail s = raise (Compile s)      (*************************************************************************
   
 (*****************************************************************************  
  *                               PARSING                                     *  
  *****************************************************************************)  
   
     val parseOne = SmlFile.parseOne  
     val parse = SmlFile.parse  
   
 (*****************************************************************************  
17   *                               ELABORATION                                 *   *                               ELABORATION                                 *
18   *****************************************************************************)       *************************************************************************)
19    
20  (** several preprocessing phases done after parsing or after elaborations *)      (** several preprocessing phases done after parsing or
21         ** after elaborations *)
22  (*  (*
23  val fixityparse = (* ST.doPhase (ST.makePhase "Compiler 005 fixityparse") *)      val fixityparse =
24            (* Stats.doPhase (Stats.makePhase "Compiler 005 fixityparse") *)
25    FixityParse.fixityparse    FixityParse.fixityparse
26  val lazycomp = (* ST.doPhase (ST.makePhase "Compiler 006 lazycomp") *)      val lazycomp =
27            (* Stats.doPhase (Stats.makePhase "Compiler 006 lazycomp") *)
28    LazyComp.lazycomp    LazyComp.lazycomp
29  *)  *)
30  val pickUnpick =  val pickUnpick =
31    ST.doPhase (ST.makePhase "Compiler 036 pickunpick") CC.pickUnpick          Stats.doPhase (Stats.makePhase "Compiler 036 pickunpick") CC.pickUnpick
32    
33  (** take ast, do semantic checks, and output the new env, absyn and pickles *)      (** take ast, do semantic checks,
34         ** and output the new env, absyn and pickles *)
35  fun elaborate {ast=ast, statenv=senv, compInfo=cinfo} = let  fun elaborate {ast=ast, statenv=senv, compInfo=cinfo} = let
36    
37        val (absyn, nenv) = ElabTop.elabTop(ast, senv, cinfo)        val (absyn, nenv) = ElabTop.elabTop(ast, senv, cinfo)
38        val (absyn, nenv) =        val (absyn, nenv) =
39          if anyErrors (cinfo) then (A.SEQdec nil, SE.empty) else (absyn, nenv)              if CompInfo.anyErrors cinfo then
40                    (Absyn.SEQdec nil, StaticEnv.empty)
41                else (absyn, nenv)
42        val { hash, pickle, exportLvars, exportPid, newenv } =        val { hash, pickle, exportLvars, exportPid, newenv } =
43            pickUnpick { context = senv, env = nenv }            pickUnpick { context = senv, env = nenv }
44     in {absyn=absyn, newstatenv=newenv, exportPid=exportPid,     in {absyn=absyn, newstatenv=newenv, exportPid=exportPid,
45         exportLvars=exportLvars, staticPid = hash, pickle=pickle }         exportLvars=exportLvars, staticPid = hash, pickle=pickle }
46  end (* function elaborate *)  end (* function elaborate *)
47    
48  val elaborate = ST.doPhase(ST.makePhase "Compiler 030 elaborate") elaborate      val elaborate =
49            Stats.doPhase(Stats.makePhase "Compiler 030 elaborate") elaborate
50    
51  (*****************************************************************************      (*************************************************************************
52   *                          ABSYN INSTRUMENTATION                            *   *                          ABSYN INSTRUMENTATION                            *
53   *****************************************************************************)       *************************************************************************)
54    
55  (** instrumenting the abstract syntax to do time- and space-profiling *)  (** instrumenting the abstract syntax to do time- and space-profiling *)
56  fun instrument {source, senv, compInfo} =  fun instrument {source, senv, compInfo} =
# Line 98  Line 58 
58        o TProf.instrumDec (senv, compInfo)        o TProf.instrumDec (senv, compInfo)
59        o BTrace.instrument (senv, compInfo)        o BTrace.instrument (senv, compInfo)
60    
61  val instrument = ST.doPhase (ST.makePhase "Compiler 039 instrument") instrument      val instrument =
62            Stats.doPhase (Stats.makePhase "Compiler 039 instrument") instrument
63    
64  (*****************************************************************************      (*************************************************************************
65   *                         TRANSLATION INTO FLINT                            *   *                         TRANSLATION INTO FLINT                            *
66   *****************************************************************************)       *************************************************************************)
67    
68  (** take the abstract syntax tree, generate the flint intermediate code *)  (** take the abstract syntax tree, generate the flint intermediate code *)
69  fun translate{absyn, exportLvars, newstatenv, oldstatenv, compInfo} =  fun translate{absyn, exportLvars, newstatenv, oldstatenv, compInfo} =
70    (*** statenv used for printing Absyn in messages ***)    (*** statenv used for printing Absyn in messages ***)
71    let val statenv = SE.atop (newstatenv, oldstatenv)          let val statenv = StaticEnv.atop (newstatenv, oldstatenv)
72        val {flint, imports} =          in
73              Translate.transDec(absyn, exportLvars, statenv, compInfo)              Translate.transDec(absyn, exportLvars, statenv, compInfo)
    in {flint=flint, imports=imports}  
74    end    end
75    
76  val translate = ST.doPhase (ST.makePhase "Compiler 040 translate") translate      val translate =
77            Stats.doPhase (Stats.makePhase "Compiler 040 translate") translate
78    
79    
80  (*****************************************************************************      (*************************************************************************
81   *                         CODE GENERATION                                   *   *                         CODE GENERATION                                   *
82   *****************************************************************************)       *************************************************************************)
83    
84  (** take the flint code and generate the machine binary code *)  (** take the flint code and generate the machine binary code *)
85  local  local
86      val inline = LSplitInline.inline      val inline = LSplitInline.inline
87      val addCode = ST.addStat (ST.makeStat "Code Size")          val addCode = Stats.addStat (Stats.makeStat "Code Size")
88  in  in
89      fun codegen { flint: flint, imports: import list, symenv: symenv,          fun codegen { flint, imports, symenv, splitting, compInfo } = let
                   splitting: int option, compInfo: compInfo } = let  
90          (* hooks for cross-module inlining and specialization *)          (* hooks for cross-module inlining and specialization *)
91          val (flint, revisedImports) = inline (flint, imports, symenv)          val (flint, revisedImports) = inline (flint, imports, symenv)
92    
# Line 138  Line 97 
97          val codeSz =          val codeSz =
98                List.foldl                List.foldl
99                  (fn (co, n) => n + CodeObj.size co)                  (fn (co, n) => n + CodeObj.size co)
100                    (CodeObj.size(#c0 csegs) + W8V.length(#data csegs))                      (CodeObj.size(#c0 csegs) + Word8Vector.length(#data csegs))
101                      (#cn csegs)                      (#cn csegs)
102      in      in
103          addCode codeSz;          addCode codeSz;
# Line 147  Line 106 
106  end (* local codegen *)  end (* local codegen *)
107    
108  (*  (*
109  val codegen = ST.doPhase (ST.makePhase "Compiler 140 CodeGen") codegen      val codegen =
110            Stats.doPhase (Stats.makePhase "Compiler 140 CodeGen") codegen
111  *)  *)
112    
113  (*****************************************************************************      (*************************************************************************
114   *                           COMPILATION                                     *   *                           COMPILATION                                     *
115   *          = ELABORATION + TRANSLATION TO FLINT + CODE GENERATION           *   *          = ELABORATION + TRANSLATION TO FLINT + CODE GENERATION           *
116   * used by interact/evalloop.sml, batch/batchutil.sml, batch/cmsa.sml only   *       * used by interact/evalloop.sml, cm/compile/compile.sml only            *
117   *****************************************************************************)       *************************************************************************)
118  (** compiling the ast into the binary code = elab + translate + codegen *)  (** compiling the ast into the binary code = elab + translate + codegen *)
119  fun compile {source=source, ast=ast, statenv, symenv=symenv,  fun compile {source=source, ast=ast, statenv, symenv=symenv,
120               compInfo=cinfo, checkErr=check, splitting=splitting} =               compInfo=cinfo, checkErr=check, splitting=splitting} =
# Line 193  Line 153 
153            inlineExp = inlineExp,            inlineExp = inlineExp,
154            imports = revisedImports }            imports = revisedImports }
155      end (* function compile *)      end (* function compile *)
   
 (*****************************************************************************  
  *                        OTHER UTILITY FUNCTIONS                            *  
  *****************************************************************************)  
   
 (** build the new symbolic environment *)  
 fun mksymenv (NONE, _) = SymbolicEnv.empty  
   | mksymenv (_, NONE) = SymbolicEnv.empty  
   | mksymenv (SOME pid, SOME l) = SymbolicEnv.singleton (pid, l)  
   
 (** turn the byte-vector-like code segments into an executable closure *)  
 fun mkexec (cs : CodeObj.csegments) = let  
       val ex = CodeObj.exec (#c0 cs)  
       val nex = if (W8V.length(#data cs) > 0)  
             then (fn ivec =>  
                 ex (Obj.mkTuple(Obj.toTuple ivec @ [CodeObj.mkLiterals(#data cs)])))  
             else (fn ivec => ex ivec)  
       in  
         foldl (fn (c, r) => (CodeObj.exec c) o r) nex (#cn cs)  
       end  
   
 (** just like f x, except that it catches top-level callcc's *)  
 local  
   val cont_stack = ref (nil : unit ref list)  
 in  
 fun isolate f x = (* Just like *)  
   let val r = ref()  
       val _ = cont_stack := r :: !cont_stack;  
       fun pop_stack() =  
            case !cont_stack  
             of r' :: rest => (cont_stack := rest;  
                               if r<>r' then raise TopLevelCallcc else ())  
              | _ => raise TopLevelCallcc (* can this ever happen? *)  
       val a = f x  
        handle e => (pop_stack();  
                     raise (case e of TopLevelException x => x | e => e))  
    in pop_stack (); a  
   end  
 end (* local of cont_stack *)  
   
 (*****************************************************************************  
  *                        EXECUTING THE EXECUTABLE                           *  
  *****************************************************************************)  
   
 (** perform the execution of the excutable, output the new dynenv *)  
 fun execute {executable, imports, exportPid, dynenv} = let  
       val args : object = let  
             fun selObj (obj, i) = (Obj.nth(obj, i)  
                   handle _ => bug "unexpected linkage interface in execute")  
             fun getObj ((p, n), zs) =  
               let fun get (obj, CB.ITNODE [], z) = obj::z  
                     | get (obj, CB.ITNODE xl, z) =  
                         let fun g ((i, n), x) = get (selObj(obj, i), n, x)  
                          in foldr g z xl  
                         end  
                   val obj =  
                     ((DE.look dynenv p) handle DE.Unbound =>  
                        (say ("lookup " ^ (PS.toHex p) ^ "\n");  
                         fail "imported objects not found or inconsistent"))  
                in get(obj, n, zs)  
               end  
             in  
               Obj.mkTuple (foldr getObj [] imports)  
             end  
       val result : object = executable args  
    in case exportPid  
        of NONE => DE.empty  
         | SOME p => DE.singleton (p, result)  
   end  
   
 val execute = ST.doPhase (ST.makePhase "Execute") execute  
   
 end (* local of CompileF *)  
156  end (* functor CompileF *)  end (* functor CompileF *)
   

Legend:
Removed from v.878  
changed lines
  Added in v.879

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