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/cm/main/cm-boot.sml
ViewVC logotype

Diff of /sml/trunk/src/cm/main/cm-boot.sml

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

revision 377, Wed Jul 7 06:55:18 1999 UTC revision 399, Thu Aug 26 09:55:09 1999 UTC
# Line 26  Line 26 
26        structure CoerceEnv = GenericVC.CoerceEnv        structure CoerceEnv = GenericVC.CoerceEnv
27        structure EM = GenericVC.ErrorMsg        structure EM = GenericVC.ErrorMsg
28        structure BF = HostMachDepVC.Binfile        structure BF = HostMachDepVC.Binfile
29          structure P = OS.Path
30          structure F = OS.FileSys
31    
32        val os = SMLofNJ.SysInfo.getOSKind ()        val os = SMLofNJ.SysInfo.getOSKind ()
33    
# Line 36  Line 38 
38        val emptydyn = E.dynamicPart E.emptyEnv        val emptydyn = E.dynamicPart E.emptyEnv
39        val system_values = ref emptydyn        val system_values = ref emptydyn
40    
41        (* Instantiate the persistent state functor; this includes        structure Link =
42         * the binfile cache and the dynamic value cache *)            LinkFn (structure MachDepVC = HostMachDepVC
       structure FullPersstate =  
           FullPersstateFn (structure MachDepVC = HostMachDepVC  
43                             val system_values = system_values)                             val system_values = system_values)
44    
45        (* Building "Exec" will automatically also build "Recomp" and        structure Compile =
46         * "RecompTraversal"... *)            CompileFn (structure MachDepVC = HostMachDepVC)
       local  
           structure E = ExecFn (structure PS = FullPersstate)  
       in  
           structure Recomp = E.Recomp  
           structure RT = E.RecompTraversal  
           structure Exec = E.Exec  
       end  
   
       structure ET = CompileGenericFn (structure CT = Exec)  
47    
48        structure AutoLoad = AutoLoadFn        structure AutoLoad = AutoLoadFn
49            (structure RT = RT            (structure C = Compile
50             structure ET = ET)             structure L = Link)
   
       (* The StabilizeFn functor needs a way of converting bnodes to  
        * dependency-analysis environments.  This can be achieved quite  
        * conveniently by a "recompile" traversal for bnodes. *)  
       fun bn2statenv gp i = #1 (#stat (valOf (RT.bnode' gp i)))  
           handle Option => raise Fail "bn2statenv"  
   
       (* exec_group is basically the same as ET.group with  
        * two additional actions to be taken:  
        *   1. Before executing the code, we announce the priviliges  
        *      that are being invoked.  (For the time being, we assume  
        *      that everybody has every conceivable privilege, but at the  
        *      very least we announce which ones are being made use of.)  
        *   2. After we are done we must make the values of "shared"  
        *      compilation units permanent. *)  
       fun exec_group gp (g as GroupGraph.GROUP { required = rq, ... }) =  
           (if StringSet.isEmpty rq then ()  
            else Say.say ("$Execute: required privileges are:\n" ::  
                      map (fn s => ("  " ^ s ^ "\n")) (StringSet.listItems rq));  
            ET.group gp g)  
51    
52        fun recomp_runner gp g = isSome (RT.group gp g)        fun recomp_runner gp g = let
53              val { group, ... } = Compile.newTraversal (Link.evict, g)
54          in
55              isSome (group gp) before Link.cleanup ()
56          end
57    
58        (* This function combines the actions of "recompile" and "exec".        (* This function combines the actions of "recompile" and "exec".
59         * When successful, it combines the results (thus forming a full         * When successful, it combines the results (thus forming a full
60         * environment) and adds it to the toplevel environment. *)         * environment) and adds it to the toplevel environment. *)
61        fun make_runner gp g =        fun make_runner gp g = let
62            case RT.group gp g of            val { group = c_group, ... } = Compile.newTraversal (Link.evict, g)
63              val { group = l_group, ... } = Link.newTraversal g
64              val GroupGraph.GROUP { required = rq, ... } = g
65          in
66              case c_group gp of
67                NONE => false                NONE => false
68              | SOME { stat, sym} =>              | SOME { stat, sym} =>
69                    (case exec_group gp g of                    (* Before executing the code, we announce the priviliges
70                       * that are being invoked.  (For the time being, we assume
71                       * that everybody has every conceivable privilege, but at
72                       * the very least we announce which ones are being made
73                       * use of.) *)
74                      (Link.cleanup ();
75                       if StringSet.isEmpty rq then ()
76                       else Say.say ("$Execute: required privileges are:\n" ::
77                         map (fn s => ("  " ^ s ^ "\n")) (StringSet.listItems rq));
78                       case l_group gp of
79                         NONE => false                         NONE => false
80                       | SOME dyn => let                       | SOME dyn => let
81                             val delta = E.mkenv { static = stat, symbolic = sym,                             val delta = E.mkenv { static = stat, symbolic = sym,
# Line 99  Line 87 
87                             Say.vsay ["[New bindings added.]\n"];                             Say.vsay ["[New bindings added.]\n"];
88                             true                             true
89                         end)                         end)
90          end
91    
92        val al_greg = GroupReg.new ()        val al_greg = GroupReg.new ()
93    
94        (* Instantiate the stabilization mechanism. *)        (* Instantiate the stabilization mechanism. *)
95        structure Stabilize =        structure Stabilize =
96            StabilizeFn (val bn2statenv = bn2statenv            StabilizeFn (val recomp = recomp_runner
97                         val recomp = recomp_runner                         val writeBFC = Compile.writeBFC
98                         val transfer_state = FullPersstate.transfer_state)                         val sizeBFC = Compile.sizeBFC
99                           val getII = Compile.getII
100                           val destroy_state = Link.evict)
101    
102        (* Access to the stabilization mechanism is integrated into the        (* Access to the stabilization mechanism is integrated into the
103         * parser. I'm not sure if this is the cleanest way, but it works         * parser. I'm not sure if this is the cleanest way, but it works
# Line 211  Line 202 
202            val make = run NONE make_runner            val make = run NONE make_runner
203    
204            fun reset () =            fun reset () =
205                (FullPersstate.reset ();                (Compile.reset ();
206                 RT.reset ();                 Link.reset ();
                ET.reset ();  
                Recomp.reset ();  
                Exec.reset ();  
207                 AutoLoad.reset ();                 AutoLoad.reset ();
208                 Parse.reset ();                 Parse.reset ();
209                 SmlInfo.forgetAllBut SrcPathSet.empty)                 SmlInfo.forgetAllBut SrcPathSet.empty)
# Line 224  Line 212 
212                val _ = let                val _ = let
213                    fun listDir ds = let                    fun listDir ds = let
214                        fun loop l =                        fun loop l =
215                            case OS.FileSys.readDir ds of                            case F.readDir ds of
216                                "" => l                                "" => l
217                              | x => loop (x :: l)                              | x => loop (x :: l)
218                    in                    in
219                        loop []                        loop []
220                    end                    end
221                    val fileList = SafeIO.perform                    val fileList = SafeIO.perform
222                        { openIt = fn () => OS.FileSys.openDir bootdir,                        { openIt = fn () => F.openDir bootdir,
223                          closeIt = OS.FileSys.closeDir,                          closeIt = F.closeDir,
224                          work = listDir,                          work = listDir,
225                          cleanup = fn () => () }                          cleanup = fn () => () }
226                    fun isDir x =                    fun isDir x = F.isDir x handle _ => false
                       OS.FileSys.isDir x handle _ => false  
227                    fun subDir x = let                    fun subDir x = let
228                        val d = OS.Path.concat (bootdir, x)                        val d = P.concat (bootdir, x)
229                    in                    in
230                        if isDir d then SOME (x, d) else NONE                        if isDir d then SOME (x, d) else NONE
231                    end                    end
# Line 269  Line 256 
256                         * been cheating, and if we ever have to try and                         * been cheating, and if we ever have to try and
257                         * fetch assembly.sig or core.sml in a separate                         * fetch assembly.sig or core.sml in a separate
258                         * traversal, it will fail. *)                         * traversal, it will fail. *)
259                        val rtts = RT.start ()                        val sbnode = Compile.newSbnodeTraversal (fn _ => ())
260                        fun get n = let                        fun get n = let
261                            val { stat = (s, sp), sym = (sy, syp), ctxt, bfc } =                            val { ii, ctxt } = valOf (sbnode ginfo n)
262                                valOf (RT.sbnode rtts ginfo n)                            val { statpid, statenv, symenv, sympid } = ii
263                            (* Since we cannot start another recomp traversal,                            (* We have not implemented the "sbnode" part
264                             * we must also avoid exec traversals (because they                             * in the Link module.
                            * would internally trigger recomp traversals).  
265                             * But at boot time any relevant value should be                             * But at boot time any relevant value should be
266                             * available as a sysval, so there is no problem. *)                             * available as a sysval, so there is no problem.
267                            val d =                             *
268                                case Option.map (FullPersstate.sysval o                             * WARNING!  HACK!
269                                                 BF.exportPidOf) bfc of                             * We are cheating somewhat by taking advantage
270                                    SOME (SOME d) => d                             * of the fact that the staticPid is always
271                                  | _ => emptydyn                             * the same as the exportPid if the latter exists.
272                            val env = E.mkenv { static = s, symbolic = sy,                             *)
273                              val d = case Link.sysval (SOME statpid) of
274                                  SOME d => d
275                                | NONE => emptydyn
276                              val env = E.mkenv { static = statenv (),
277                                                  symbolic = symenv (),
278                                                dynamic = d }                                                dynamic = d }
279                            val pidInfo = { statpid = sp, sympid = syp,                            val pidInfo = { statpid = statpid,
280                                              sympid = sympid,
281                                            ctxt = ctxt }                                            ctxt = ctxt }
282                        in                        in
283                            (env, pidInfo)                            (env, pidInfo)
# Line 312  Line 304 
304                                             #statpid pervPidInfo,                                             #statpid pervPidInfo,
305                                             #sympid pervPidInfo])                                             #sympid pervPidInfo])
306                    in                    in
307                        (* Nobody is going to try and share this state --                        Compile.reset ();
308                         * or, rather, this state is shared via access                        Link.reset ();
                        * to "primitives".  Therefore, we don't call  
                        * RT.finish and ET.finish and reset the state. *)  
                       FullPersstate.reset ();  
309                        #set ER.core corenv;                        #set ER.core corenv;
310                        #set ER.pervasive pervasive;                        #set ER.pervasive pervasive;
311                        #set ER.topLevel BE.emptyEnv;                        #set ER.topLevel BE.emptyEnv;
# Line 347  Line 336 
336                                        EnvConfig.getSet StdConfig.debug,                                        EnvConfig.getSet StdConfig.debug,
337                                     keep_going =                                     keep_going =
338                                        EnvConfig.getSet StdConfig.keep_going,                                        EnvConfig.getSet StdConfig.keep_going,
339                                       warn_obsolete =
340                                          EnvConfig.getSet StdConfig.warn_obsolete,
341                                     parse_caching =                                     parse_caching =
342                                        EnvConfig.getSet StdConfig.parse_caching,                                        EnvConfig.getSet StdConfig.parse_caching,
343                                     setAnchor = setAnchor,                                     setAnchor = setAnchor,

Legend:
Removed from v.377  
changed lines
  Added in v.399

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