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/branches/SMLNJ/src/compiler/TopLevel/batch/cmsa.sml
ViewVC logotype

Diff of /sml/branches/SMLNJ/src/compiler/TopLevel/batch/cmsa.sml

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

revision 23, Thu Mar 12 00:49:56 1998 UTC revision 24, Thu Mar 12 00:49:58 1998 UTC
# Line 1  Line 1 
1  (* COPYRIGHT (c) 1997 Bell Labs, Lucent Technologies *)  (* cmsa.sml
2  (* cmsa.sml *)   *
3     * COPYRIGHT (c) 1997 Bell Labs, Lucent Technologies.
4     *)
5    
6  functor CMSAFun (structure BU : BATCHUTIL  signature CMSA = sig
7                   structure C  : COMPILE) :> CMSA = struct  
8        type env                            (* environments *)
9        type sym                            (* symbols *)
10    
11        (* build symbols from strings *)
12        val STR: string -> sym              (* structure *)
13        val SIG: string -> sym              (* signature *)
14        val FCT: string -> sym              (* functor *)
15        val FSIG: string -> sym             (* funsig *)
16    
17        val pervenv: unit -> env            (* fetch pervasive environment *)
18        val register: env -> unit           (* register delta with toplevel env. *)
19    
20        (* load or compile (1st arg), then execute *)
21        val run: string * env -> env
22        (* layer environments, head of list goes on top *)
23        val layer: env list -> env
24        (* filter environment by list of symbols *)
25        val filter: sym list -> env -> env
26    
27    end
28    
29    functor CMSAFun (structure CUnitUtil: CUNITUTIL
30                     structure Compile: COMPILE
31                     val arch: string) :> CMSA = struct
32    
33      structure E = SCEnv.Env      structure E = SCEnv.Env
34        structure CUU = CUnitUtil
35        structure C = Compile
36      structure P = Control.Print      structure P = Control.Print
     structure S = Symbol  
37    
38      type env = E.environment            (* environments *)      type env = E.environment            (* environments *)
39      type sym = S.symbol         (* symbols *)      type sym = Symbol.symbol            (* symbols *)
40    
41      (* build symbols from strings *)      (* build symbols from strings *)
42      val STR = S.strSymbol               (* structure *)      val STR = Symbol.strSymbol          (* structure *)
43      val SIG = S.sigSymbol               (* signature *)      val SIG = Symbol.sigSymbol          (* signature *)
44      val FCT = S.fctSymbol               (* functor *)      val FCT = Symbol.fctSymbol          (* functor *)
45      val FSIG = S.fsigSymbol     (* funsig *)      val FSIG = Symbol.fsigSymbol        (* funsig *)
46    
47      (* fetch the pervasive environment *)      (* fetch the pervasive environment *)
48      fun pervenv () = #get EnvRef.pervasive ()      fun pervenv () = #get EnvRef.pervasive ()
# Line 41  Line 68 
68       * if this fails, then try compiling the source (1st argument);       * if this fails, then try compiling the source (1st argument);
69       * after one of the two steps succeeds run the code *)       * after one of the two steps succeeds run the code *)
70      fun run (source, base) = let      fun run (source, base) = let
71            fun runcode (code, imports, exportPid, ste, sye) = let
72                val _ = P.say "ok - executing..."
73                val de = C.execute { executable = code,
74                                     imports = imports,
75                                     exportPid = exportPid,
76                                     dynenv = E.dynamicPart base }
77                val e = E.mkenv { static = ste, dynamic = de, symbolic = sye }
78                val _ = P.say "done\n"
79            in
80                e
81            end
82          fun loadbin () = let          fun loadbin () = let
83              val { dir, file } = OS.Path.splitDirFile source              val { dir, file } = OS.Path.splitDirFile source
84              val cmdir = OS.Path.joinDirFile { dir = dir, file = "CM" }              val cmdir = OS.Path.joinDirFile { dir = dir, file = "CM" }
# Line 52  Line 90 
90                    | SMLofNJ.SysInfo.MACOS => "macos"                    | SMLofNJ.SysInfo.MACOS => "macos"
91                    | SMLofNJ.SysInfo.OS2 => "os2"                    | SMLofNJ.SysInfo.OS2 => "os2"
92                    | SMLofNJ.SysInfo.BEOS => "beos"                    | SMLofNJ.SysInfo.BEOS => "beos"
93              val arch'os = concat [BU.arch, "-", oskind]              val arch'os = concat [arch, "-", oskind]
94              val archosdir = OS.Path.joinDirFile { dir = cmdir, file = arch'os }              val archosdir = OS.Path.joinDirFile { dir = cmdir, file = arch'os }
95              val bin = OS.Path.joinDirFile { dir = archosdir, file = file }              val bin = OS.Path.joinDirFile { dir = archosdir, file = file }
96              val _ = P.say (concat ["Loading: ", bin, "..."])              val _ = P.say (concat ["Loading: ", bin, "..."])
97              val f = BinIO.openIn bin              val f = BinIO.openIn bin
98              fun rest () = let              fun rest () = let
99                  val cu = BU.readUnit { name = bin,                  val cu = CUU.readUnit { name = bin,
100                                          stream = f,                                          stream = f,
101                                          pids2iid = fn _ => (),                                          pids2iid = fn _ => (),
102                                          senv = E.staticPart base,                                          senv = E.staticPart base,
103                                          keep_code = true }                                          keep_code = true }
104                  val _ = BinIO.closeIn f                  val _ = BinIO.closeIn f
                 val _ = P.say "ok - executing..."  
                 val e = BU.execUnit(cu, E.dynamicPart base)  
                 val _ = P.say "done\n"  
105                  in                  in
106                     e                  runcode (CUU.codeClosure cu,
107                             CUU.importsCU cu,
108                             CUU.exportCU cu,
109                             CUU.senvCU cu, CUU.symenvCU cu)
110                  end                  end
111          in          in
112              rest () handle e => (BinIO.closeIn f; raise e)              rest () handle e => (BinIO.closeIn f; raise e)
# Line 96  Line 134 
134                  else ()                  else ()
135              val corenv = #get EnvRef.core ()              val corenv = #get EnvRef.core ()
136              val cinfo = C.mkCompInfo (source, corenv, fn x => x)              val cinfo = C.mkCompInfo (source, corenv, fn x => x)
137                val senv = E.staticPart base
138              val {csegments=code, newstatenv, exportPid, imports,              val { absyn, newenv, exportLvars, staticPid, exportPid,
139                   inlineExp, ...} =                    pickle } =
140                     C.compile {source=source, ast=ast,                  C.elaborate { compInfo = cinfo, compenv = senv, ast = ast }
141                                statenv=E.staticPart base,                  before check "elaboration"
142                                symenv=E.symbolicPart base,              val absyn =
143                                compInfo=cinfo, checkErr=check,                  C.instrument { compenv = senv, source = source,
144                                runtimePid=NONE, splitting=true}                                 compInfo = cinfo }
145              val obj = C.mkexec code                               absyn
146              val _ = P.say "ok - executing..."              val { genLambda, imports } =
147              val ndenv = C.execute {executable=C.mkexec code,                  C.translate { compInfo = cinfo, absyn = absyn,
148                                     imports=imports, exportPid=exportPid,                                exportLvars = exportLvars,
149                                     dynenv=E.dynamicPart base}                                newstatenv = newenv,
150              val _ = P.say "done\n"                                oldstatenv = senv,
151                                  exportPid = exportPid }
152                    before check "translation"
153                val lambda = C.inline { genLambda = genLambda,
154                                        imports = imports,
155                                        symenv = E.symbolicPart base }
156                val { lambda_e, lambda_i } =
157                    C.split { lambda = lambda, enable = true }
158                val code = C.codegen { compInfo = cinfo, lambda = lambda_e }
159                    before check "codegen"
160          in          in
161              E.mkenv {static=newstatenv, dynamic=ndenv,              runcode (C.applyCode code, imports, exportPid,
162                       symbolic= C.mksymenv(exportPid, inlineExp)}                       newenv, C.symDelta (exportPid, lambda_i))
163          end          end
164      in      in
165          loadbin () handle _ => compilesource ()          loadbin () handle _ => compilesource ()
166      end      end
167    end
168    
169  end (* functor CMSAFun *)  (*
170     * $Log: cmsa.sml,v $
171    # Revision 1.7  1997/08/26  19:18:13  jhr
172    #   Added copyright and Log.
173    #
174     *)
   
   
   
175    

Legend:
Removed from v.23  
changed lines
  Added in v.24

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