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 375, Wed Jul 7 03:08:04 1999 UTC revision 433, Mon Sep 13 06:57:29 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 Compile =
42         * the binfile cache and the dynamic value cache *)            CompileFn (structure MachDepVC = HostMachDepVC)
       structure FullPersstate =  
           FullPersstateFn (structure MachDepVC = HostMachDepVC  
                            val system_values = system_values)  
43    
44        (* Building "Exec" will automatically also build "Recomp" and        structure Link =
45         * "RecompTraversal"... *)            LinkFn (structure MachDepVC = HostMachDepVC
46        local                    val system_values = system_values)
           structure E = ExecFn (structure PS = FullPersstate)  
       in  
           structure Recomp = E.Recomp  
           structure RT = E.RecompTraversal  
           structure Exec = E.Exec  
       end  
47    
48        structure ET = CompileGenericFn (structure CT = Exec)        structure BFC =
49              BfcFn (structure MachDepVC = HostMachDepVC)
50    
51        structure AutoLoad = AutoLoadFn        structure AutoLoad = AutoLoadFn
52            (structure RT = RT            (structure C = Compile
53             structure ET = ET)             structure L = Link
54               structure BFC = BFC)
55        (* The StabilizeFn functor needs a way of converting bnodes to  
56         * dependency-analysis environments.  This can be achieved quite        fun recomp_runner gp g = let
57         * conveniently by a "recompile" traversal for bnodes. *)            fun store _ = ()
58        fun bn2statenv gp i = #1 (#stat (valOf (RT.bnode' gp i)))            val { group, ... } = Compile.newTraversal (Link.evict, store, g)
59            handle Option => raise Fail "bn2statenv"        in
60              isSome (group gp) before Link.cleanup gp
61        (* exec_group is basically the same as ET.group with        end
        * 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)  
   
       fun recomp_runner gp g = isSome (RT.group gp g)  
62    
63        (* This function combines the actions of "recompile" and "exec".        (* This function combines the actions of "recompile" and "exec".
64         * When successful, it combines the results (thus forming a full         * When successful, it combines the results (thus forming a full
65         * environment) and adds it to the toplevel environment. *)         * environment) and adds it to the toplevel environment. *)
66        fun make_runner gp g =        fun make_runner gp g = let
67            case RT.group gp g of            val { store, get } = BFC.new ()
68              val { group = c_group, ... } =
69                  Compile.newTraversal (Link.evict, store, g)
70              val { group = l_group, ... } = Link.newTraversal (g, get)
71              val GroupGraph.GROUP { required = rq, ... } = g
72          in
73              case c_group gp of
74                NONE => false                NONE => false
75              | SOME { stat, sym} =>              | SOME { stat, sym} =>
76                    (case exec_group gp g of                    (* Before executing the code, we announce the priviliges
77                       * that are being invoked.  (For the time being, we assume
78                       * that everybody has every conceivable privilege, but at
79                       * the very least we announce which ones are being made
80                       * use of.) *)
81                      (Link.cleanup gp;
82                       if StringSet.isEmpty rq then ()
83                       else Say.say ("$Execute: required privileges are:\n" ::
84                         map (fn s => ("  " ^ s ^ "\n")) (StringSet.listItems rq));
85                       case l_group gp of
86                         NONE => false                         NONE => false
87                       | SOME dyn => let                       | SOME dyn => let
88                             val delta = E.mkenv { static = stat, symbolic = sym,                             val delta = E.mkenv { static = stat, symbolic = sym,
# Line 99  Line 94 
94                             Say.vsay ["[New bindings added.]\n"];                             Say.vsay ["[New bindings added.]\n"];
95                             true                             true
96                         end)                         end)
97          end
98    
99        val al_greg = GroupReg.new ()        val al_greg = GroupReg.new ()
100    
101        (* Instantiate the stabilization mechanism. *)        (* Instantiate the stabilization mechanism. *)
102        structure Stabilize =        structure Stabilize =
103            StabilizeFn (val bn2statenv = bn2statenv            StabilizeFn (structure MachDepVC = HostMachDepVC
104                         val recomp = recomp_runner                         fun recomp gp g = let
105                         val transfer_state = FullPersstate.transfer_state)                             val { store, get } = BFC.new ()
106                               val { group, ... } =
107                                   Compile.newTraversal (Link.evict, store, g)
108                           in
109                               case group gp of
110                                   NONE => NONE
111                                 | SOME _ => SOME get
112                           end
113                           fun destroy_state gp i =
114                               (Compile.evict i; Link.evict gp i)
115                           val getII = Compile.getII)
116    
117        (* Access to the stabilization mechanism is integrated into the        (* Access to the stabilization mechanism is integrated into the
118         * 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 129  Line 135 
135            val theValues = ref (NONE: kernelValues option)            val theValues = ref (NONE: kernelValues option)
136    
137        in        in
138            fun setAnchor (a, s) = PathConfig.set (pcmode, a, s)            fun setAnchor (a, s) =
139                  (PathConfig.set (pcmode, a, s); SrcPath.sync ())
140              (* cancelling anchors cannot affect the order of existing paths
141               * (it may invalidate some paths; but all other ones stay as
142               * they are) *)
143            fun cancelAnchor a = PathConfig.cancel (pcmode, a)            fun cancelAnchor a = PathConfig.cancel (pcmode, a)
144              (* same goes for reset because it just cancels all anchors... *)
145            fun resetPathConfig () = PathConfig.reset pcmode            fun resetPathConfig () = PathConfig.reset pcmode
146    
147            fun showPending () = let            fun showPending () = let
# Line 145  Line 156 
156            end            end
157    
158            fun initPaths () = let            fun initPaths () = let
159                val lpcth = EnvConfig.getSet StdConfig.local_pathconfig NONE                val lpcth = #get StdConfig.local_pathconfig ()
160                val p = case lpcth () of                val p = case lpcth () of
161                    NONE => []                    NONE => []
162                  | SOME f => [f]                  | SOME f => [f]
163                val p = EnvConfig.getSet StdConfig.pathcfgspec NONE :: p                val p = #get StdConfig.pathcfgspec () :: p
164                fun processOne f = PathConfig.processSpecFile (pcmode, f)                fun processOne f = PathConfig.processSpecFile (pcmode, f)
165                    handle _ => ()                    handle _ => ()
166            in            in
# Line 164  Line 175 
175                { primconf = #primconf v,                { primconf = #primconf v,
176                  fnpolicy = fnpolicy,                  fnpolicy = fnpolicy,
177                  pcmode = pcmode,                  pcmode = pcmode,
178                  symenv = SSV.env,                  symval = SSV.symval,
179                  keep_going = EnvConfig.getSet StdConfig.keep_going NONE,                  keep_going = #get StdConfig.keep_going (),
180                  pervasive = #pervasive v,                  pervasive = #pervasive v,
181                  corenv = #corenv v,                  corenv = #corenv v,
182                  pervcorepids = #pervcorepids v }                  pervcorepids = #pervcorepids v }
# Line 199  Line 210 
210                  | SOME (g, gp) => f gp g                  | SOME (g, gp) => f gp g
211            end            end
212    
213              val listLibs = Parse.listLibs
214              fun dismissLib l = let
215                  val c = SrcPath.cwdContext ()
216                  val p = SrcPath.standard pcmode { context = c, spec = l }
217              in
218                  Parse.dismissLib p
219              end
220    
221            fun stabilize_runner gp g = true            fun stabilize_runner gp g = true
222    
223            fun stabilize recursively = run (SOME recursively) stabilize_runner            fun stabilize recursively = run (SOME recursively) stabilize_runner
# Line 206  Line 225 
225            val make = run NONE make_runner            val make = run NONE make_runner
226    
227            fun reset () =            fun reset () =
228                (FullPersstate.reset ();                (Compile.reset ();
229                 RT.reset ();                 Link.reset ();
                ET.reset ();  
                Recomp.reset ();  
                Exec.reset ();  
230                 AutoLoad.reset ();                 AutoLoad.reset ();
231                 Parse.reset ();                 Parse.reset ();
232                 SmlInfo.forgetAllBut SrcPathSet.empty)                 SmlInfo.forgetAllBut SrcPathSet.empty)
# Line 219  Line 235 
235                val _ = let                val _ = let
236                    fun listDir ds = let                    fun listDir ds = let
237                        fun loop l =                        fun loop l =
238                            case OS.FileSys.readDir ds of                            case F.readDir ds of
239                                "" => l                                "" => l
240                              | x => loop (x :: l)                              | x => loop (x :: l)
241                    in                    in
242                        loop []                        loop []
243                    end                    end
244                    val fileList = SafeIO.perform                    val fileList = SafeIO.perform
245                        { openIt = fn () => OS.FileSys.openDir bootdir,                        { openIt = fn () => F.openDir bootdir,
246                          closeIt = OS.FileSys.closeDir,                          closeIt = F.closeDir,
247                          work = listDir,                          work = listDir,
248                          cleanup = fn () => () }                          cleanup = fn () => () }
249                    fun isDir x =                    fun isDir x = F.isDir x handle _ => false
                       OS.FileSys.isDir x handle _ => false  
250                    fun subDir x = let                    fun subDir x = let
251                        val d = OS.Path.concat (bootdir, x)                        val d = P.concat (bootdir, x)
252                    in                    in
253                        if isDir d then SOME (x, d) else NONE                        if isDir d then SOME (x, d) else NONE
254                    end                    end
# Line 247  Line 262 
262                val ginfo = { param = { primconf = Primitive.primEnvConf,                val ginfo = { param = { primconf = Primitive.primEnvConf,
263                                        fnpolicy = fnpolicy,                                        fnpolicy = fnpolicy,
264                                        pcmode = pcmode,                                        pcmode = pcmode,
265                                        symenv = SSV.env,                                        symval = SSV.symval,
266                                        keep_going = false,                                        keep_going = false,
267                                        pervasive = E.emptyEnv,                                        pervasive = E.emptyEnv,
268                                        corenv = BE.staticPart BE.emptyEnv,                                        corenv = BE.staticPart BE.emptyEnv,
# Line 264  Line 279 
279                         * been cheating, and if we ever have to try and                         * been cheating, and if we ever have to try and
280                         * fetch assembly.sig or core.sml in a separate                         * fetch assembly.sig or core.sml in a separate
281                         * traversal, it will fail. *)                         * traversal, it will fail. *)
282                        val rtts = RT.start ()                        val sbnode = Compile.newSbnodeTraversal ()
283                        fun get n = let                        fun get n = let
284                            val { stat = (s, sp), sym = (sy, syp), ctxt, bfc } =                            val { ii, ctxt } = valOf (sbnode ginfo n)
285                                valOf (RT.sbnode rtts ginfo n)                            val { statpid, statenv, symenv, sympid } = ii
286                            (* Since we cannot start another recomp traversal,                            (* We have not implemented the "sbnode" part
287                             * we must also avoid exec traversals (because they                             * in the Link module.
                            * would internally trigger recomp traversals).  
288                             * But at boot time any relevant value should be                             * But at boot time any relevant value should be
289                             * available as a sysval, so there is no problem. *)                             * available as a sysval, so there is no problem.
290                            val d =                             *
291                                case Option.map (FullPersstate.sysval o                             * WARNING!  HACK!
292                                                 BF.exportPidOf) bfc of                             * We are cheating somewhat by taking advantage
293                                    SOME (SOME d) => d                             * of the fact that the staticPid is always
294                                  | _ => emptydyn                             * the same as the exportPid if the latter exists.
295                            val env = E.mkenv { static = s, symbolic = sy,                             *)
296                              val d = case Link.sysval (SOME statpid) of
297                                  SOME d => d
298                                | NONE => emptydyn
299                              val env = E.mkenv { static = statenv (),
300                                                  symbolic = symenv (),
301                                                dynamic = d }                                                dynamic = d }
302                            val pidInfo = { statpid = sp, sympid = syp,                            val pidInfo = { statpid = statpid,
303                                              sympid = sympid,
304                                            ctxt = ctxt }                                            ctxt = ctxt }
305                        in                        in
306                            (env, pidInfo)                            (env, pidInfo)
# Line 307  Line 327 
327                                             #statpid pervPidInfo,                                             #statpid pervPidInfo,
328                                             #sympid pervPidInfo])                                             #sympid pervPidInfo])
329                    in                    in
330                        (* Nobody is going to try and share this state --                        Compile.reset ();
331                         * 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 ();  
332                        #set ER.core corenv;                        #set ER.core corenv;
333                        #set ER.pervasive pervasive;                        #set ER.pervasive pervasive;
334                        #set ER.topLevel BE.emptyEnv;                        #set ER.topLevel BE.emptyEnv;
# Line 336  Line 353 
353                                     make = make,                                     make = make,
354                                     autoload = autoload,                                     autoload = autoload,
355                                     reset = reset,                                     reset = reset,
356                                     verbose =                                     verbose = StdConfig.verbose,
357                                        EnvConfig.getSet StdConfig.verbose,                                     debug = StdConfig.debug,
358                                     debug =                                     keep_going = StdConfig.keep_going,
359                                        EnvConfig.getSet StdConfig.debug,                                     warn_obsolete = StdConfig.warn_obsolete,
360                                     keep_going =                                     parse_caching = StdConfig.parse_caching,
                                       EnvConfig.getSet StdConfig.keep_going,  
                                    parse_caching =  
                                       EnvConfig.getSet StdConfig.parse_caching,  
361                                     setAnchor = setAnchor,                                     setAnchor = setAnchor,
362                                     cancelAnchor = cancelAnchor,                                     cancelAnchor = cancelAnchor,
363                                     resetPathConfig = resetPathConfig,                                     resetPathConfig = resetPathConfig,
364                                     synchronize = SrcPath.sync,                                     synchronize = SrcPath.sync,
365                                     showPending = showPending })                                     showPending = showPending,
366                                       listLibs = listLibs,
367                                       dismissLib = dismissLib,
368                                       symval = SSV.symval })
369    
370                    end                    end
371            end            end

Legend:
Removed from v.375  
changed lines
  Added in v.433

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