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

Diff of /sml/trunk/compiler/TopLevel/main/compile.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 18  Line 18 
18        structure DA = Access        structure DA = Access
19        structure CB = CompBasic        structure CB = CompBasic
20        structure ST = Stats        structure ST = Stats
21        structure CI = Unsafe.CInterface        structure Obj = Unsafe.Object
22        structure W8V = Word8Vector        structure W8V = Word8Vector
       structure V = Vector  
23  in  in
24    
25  val say = Control_Print.say  val say = Control_Print.say
# Line 174  Line 173 
173      else (flint, NONE)      else (flint, NONE)
174    
175    
   val w8vLen = W8V.length  
   fun csegsize {c0, cn, data, name} =  
     foldl (fn (x, y) => (w8vLen x) + y) (w8vLen c0 + w8vLen data) cn  
   
176    val addCode = ST.addStat (ST.makeStat "Code Size")    val addCode = ST.addStat (ST.makeStat "Code Size")
177  in  in
178      fun codegen { flint: flint, imports: import list, symenv: symenv,      fun codegen { flint: flint, imports: import list, symenv: symenv,
# Line 188  Line 183 
183    
184          (* from optimized FLINT code, generate the machine code *)          (* from optimized FLINT code, generate the machine code *)
185          val (csegs,inlineExp) = M.flintcomp(flint, compInfo)          val (csegs,inlineExp) = M.flintcomp(flint, compInfo)
186            val codeSz =
187                  List.foldl
188                    (fn (co, n) => n + CodeObj.size co)
189                      (CodeObj.size(#c0 csegs) + W8V.length(#data csegs))
190                        (#cn csegs)
191      in      in
192          addCode(csegsize csegs);          addCode codeSz;
193          { csegments=csegs, inlineExp=inlineExp, imports = revisedImports }          { csegments=csegs, inlineExp=inlineExp, imports = revisedImports }
194      end      end
195  end (* local codegen *)  end (* local codegen *)
# Line 263  Line 263 
263    | mksymenv (SOME pid, SOME l) = SymbolicEnv.singleton (pid, l)    | mksymenv (SOME pid, SOME l) = SymbolicEnv.singleton (pid, l)
264    
265  (** turn the byte-vector-like code segments into an executable closure *)  (** turn the byte-vector-like code segments into an executable closure *)
266  local  fun mkexec (cs : CodeObj.csegments) = let
267    type w8v = W8V.vector        val ex = CodeObj.exec (#c0 cs)
268    val vzero = V.fromList []        val nex = if (W8V.length(#data cs) > 0)
269    val mkCodeV : w8v * string option -> (w8v * executable) =              then (fn ivec =>
270          CI.c_function "SMLNJ-RunT" "mkCode"                  ex (Obj.mkTuple(Obj.toTuple ivec @ [CodeObj.mkLiterals(#data cs)])))
271    val mkCodeO : w8v * string option -> (w8v * (object -> object)) =              else (fn ivec => ex ivec)
         CI.c_function "SMLNJ-RunT" "mkCode"  
272  in  in
273  fun mkexec {c0: w8v, cn: w8v list, data : w8v, name: string option ref} =          foldl (fn (c, r) => (CodeObj.exec c) o r) nex (#cn cs)
   let val s = case !name of NONE => "EMPTY COMMENT <-- check"  
                           | SOME s => s  
       val nex =  
         let val (_, dt) = mkCodeV(data, NONE)  
             val (_, ex) = mkCodeV(c0, SOME s)  
          in fn ivec => ex (V.concat [ivec, V.fromList [dt vzero]])  
         end  
    in foldl (fn (c, r) => (#2 (mkCodeO (c,NONE))) o r) nex cn  
274    end    end
 end (* local *)  
275    
276  (** just like f x, except that it catches top-level callcc's *)  (** just like f x, except that it catches top-level callcc's *)
277  local  local
# Line 307  Line 297 
297   *****************************************************************************)   *****************************************************************************)
298    
299  (** perform the execution of the excutable, output the new dynenv *)  (** perform the execution of the excutable, output the new dynenv *)
300  fun execute{executable, imports, exportPid, dynenv} =  fun execute {executable, imports, exportPid, dynenv} = let
301    let val args : object V.vector =        val args : object = let
302          let fun selObj (obj, i) =              fun selObj (obj, i) = (Obj.nth(obj, i)
303                ((V.sub (Unsafe.Object.toTuple obj, i)) handle _ =>                    handle _ => bug "unexpected linkage interface in execute")
                  bug "unexpected linkage interface in execute")  
   
304              fun getObj ((p, n), zs) =              fun getObj ((p, n), zs) =
305                let fun get (obj, CB.ITNODE [], z) = obj::z                let fun get (obj, CB.ITNODE [], z) = obj::z
306                      | get (obj, CB.ITNODE xl, z) =                      | get (obj, CB.ITNODE xl, z) =
# Line 325  Line 313 
313                          fail "imported objects not found or inconsistent"))                          fail "imported objects not found or inconsistent"))
314                 in get(obj, n, zs)                 in get(obj, n, zs)
315                end                end
316                in
317           in Vector.fromList (foldr getObj [] imports)                Obj.mkTuple (foldr getObj [] imports)
318          end          end
319        val result : object = executable args        val result : object = executable args
320     in case exportPid     in case exportPid
# Line 344  Line 332 
332    
333  (*  (*
334   * $Log: compile.sml,v $   * $Log: compile.sml,v $
335     * Revision 1.9  1998/12/30 20:21:30  jhr
336     *   Modifications to support code generation directly into code objects.
337     *
338     * Revision 1.8  1998/11/18 03:54:25  jhr
339     *  New array representations.
340     *
341     * Revision 1.7  1998/10/28 18:25:43  jhr
342     *   New literal lifting and new Unsafe.Object API.
343     *
344     * Revision 1.6  1998/10/16 14:04:00  george
345     *   Implemented a hierachical bin directory structure and
346     *   broke up the Compiler structure into a machine dependent
347     *   and independent parts. [blume]
348     *
349   * Revision 1.5  1998/06/02 17:39:29  george   * Revision 1.5  1998/06/02 17:39:29  george
350   *   Changes to integrate CM functionality into the compiler --- blume   *   Changes to integrate CM functionality into the compiler --- blume
351   *   *

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