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

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

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

revision 361, Wed Jun 30 06:44:04 1999 UTC revision 362, Thu Jul 1 09:39:48 1999 UTC
# Line 1  Line 1 
1  functor LinkCM (structure HostMachDepVC : MACHDEP_VC) = struct  functor LinkCM (structure HostMachDepVC : MACHDEP_VC) = struct
2    
3      datatype envrequest = AUTOLOAD | BARE
4    
5    local    local
6        structure YaccTool = YaccTool        structure YaccTool = YaccTool
7        structure LexTool = LexTool        structure LexTool = LexTool
# Line 20  Line 22 
22            SpecificSymValFn (structure MachDepVC = HostMachDepVC            SpecificSymValFn (structure MachDepVC = HostMachDepVC
23                              val os = os)                              val os = os)
24    
25        val warmup_hook = ref (NONE: E.dynenv option)        val emptydyn = E.dynamicPart E.emptyEnv
26          val system_values = ref emptydyn
27    
28        (* Instantiate the persistent state functor; this includes        (* Instantiate the persistent state functor; this includes
29         * the binfile cache and the dynamic value cache *)         * the binfile cache and the dynamic value cache *)
30        structure FullPersstate =        structure FullPersstate =
31            FullPersstateFn (structure MachDepVC = HostMachDepVC            FullPersstateFn (structure MachDepVC = HostMachDepVC
32                             val warmup_hook = warmup_hook)                             val system_values = system_values)
33    
34        (* Create two arguments appropriate for being passed to        (* Create two arguments appropriate for being passed to
35         * CompileGenericFn. One instantiation of that functor         * CompileGenericFn. One instantiation of that functor
# Line 108  Line 111 
111        structure Stabilize =        structure Stabilize =
112            StabilizeFn (val bn2statenv = bn2statenv            StabilizeFn (val bn2statenv = bn2statenv
113                         val getPid = FullPersstate.pid_fetch_sml                         val getPid = FullPersstate.pid_fetch_sml
                        val warmup = FullPersstate.new_bininfo  
114                         val recomp = recomp_runner)                         val recomp = recomp_runner)
115    
116        (* Access to the stabilization mechanism is integrated into the        (* Access to the stabilization mechanism is integrated into the
117         * 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
118         * well enough. *)         * well enough. *)
119        structure Parse = ParseFn (structure Stabilize = Stabilize)        structure Parse = ParseFn (structure Stabilize = Stabilize
120                                     val pending = AutoLoad.getPending)
121    
122        local        local
123            type kernelValues =            type kernelValues =
# Line 178  Line 181 
181    
182            fun al_manager' (ast, _, ter) = al_manager (ast, ter)            fun al_manager' (ast, _, ter) = al_manager (ast, ter)
183    
184            fun initTheValues bootdir = let            fun run sflag f s = let
185                  val c = SrcPath.cwdContext ()
186                  val p = SrcPath.standard pcmode { context = c, spec = s }
187              in
188                  case Parse.parse NONE (param ()) sflag p of
189                      NONE => false
190                    | SOME (g, gp) => f gp g
191              end
192    
193              fun stabilize_runner gp g = true
194    
195              fun stabilize recursively = run (SOME recursively) stabilize_runner
196              val recomp = run NONE recomp_runner
197              val make = run NONE make_runner
198    
199              fun reset () =
200                  (FullPersstate.reset ();
201                   RT.resetAll ();
202                   ET.resetAll ();
203                   Recomp.reset ();
204                   Exec.reset ();
205                   AutoLoad.reset ();
206                   SmlInfo.forgetAllBut SrcPathSet.empty)
207    
208              fun initTheValues (bootdir, er) = let
209                val _ = let                val _ = let
210                    fun listDir ds = let                    fun listDir ds = let
211                        fun loop l =                        fun loop l =
# Line 262  Line 289 
289                                 pervasive = pervasive,                                 pervasive = pervasive,
290                                 corenv = corenv,                                 corenv = corenv,
291                                 pervcorepids = pervcorepids };                                 pervcorepids = pervcorepids };
292                        HostMachDepVC.Interact.installCompManager                        case er of
293                              BARE =>
294                                  (make "basis.cm";
295                                   make "host-compiler.cm";
296                                   system_values := emptydyn)
297                            | AUTOLOAD =>
298                                  (HostMachDepVC.Interact.installCompManager
299                             (SOME al_manager');                             (SOME al_manager');
300                        autoload "basis.cm";                        autoload "basis.cm";
301                        ()                                 AutoLoadHook.autoloadHook := autoload)
302                    end                    end
303            end            end
304        end        end
   
       fun stabilize_runner gp g = true  
305    in    in
306      structure CM = struct      structure CM = struct
307            val stabilize = stabilize
308          fun run sflag f s = let          val recomp = recomp
309              val c = SrcPath.cwdContext ()          val make = make
             val p = SrcPath.native { context = c, spec = s }  
         in  
             case Parse.parse NONE (param ()) sflag p of  
                 NONE => false  
               | SOME (g, gp) => f gp g  
         end  
   
         fun stabilize recursively = run (SOME recursively) stabilize_runner  
         val recomp = run NONE recomp_runner  
         val make = run NONE make_runner  
310          val autoload = autoload          val autoload = autoload
311            val reset = reset
312      end      end
313    
314      structure CMB = struct      fun init (bootdir, de, er) =
315          structure BootstrapCompile =          (system_values := de;
316              BootstrapCompileFn (structure MachDepVC = HostMachDepVC           initTheValues (bootdir, er);
                                 val os = os)  
         val make' = BootstrapCompile.compile  
         fun make () = make' NONE  
         fun setRetargetPervStatEnv x = ()  
         fun wipeOut () = ()  
     end  
   
     fun init (bootdir, de) =  
         (warmup_hook := SOME de;  
          initTheValues bootdir;  
          warmup_hook := NONE;  
317           Cleanup.install initPaths)           Cleanup.install initPaths)
318    end    end
319  end  end
   
 signature CMTOOLS = sig end  
 signature COMPILATION_MANAGER = sig end  

Legend:
Removed from v.361  
changed lines
  Added in v.362

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