--- sml/trunk/src/cm/bootstrap/btcompile.sml	1999/07/02 07:33:12	364
+++ sml/trunk/src/cm/bootstrap/btcompile.sml	1999/10/21 09:20:16	448
@@ -13,6 +13,7 @@
     val deliver' : string option -> bool
     val deliver : unit -> bool
     val reset : unit -> unit
+    val symval : string -> { get: unit -> int option, set: int option -> unit }
 end = struct
 
     structure EM = GenericVC.ErrorMsg
@@ -25,57 +26,66 @@
 				      val os = os)
     structure P = OS.Path
     structure F = OS.FileSys
+    structure BF = MachDepVC.Binfile
 
-    (* Since the bootstrap compiler never executes any of the code
-     * it produces, we don't need any dynamic values.  Therefore,
-     * we create RecompPersstate (but not FullPersstate!) and
-     * instantiate Recomp as well as RecompTraversal.
-     * Since RecompPersstate is not part of any surrounding FullPersstate,
-     * function "discard_value" simply does nothing. *)
-    structure RecompPersstate =
-	RecompPersstateFn (structure MachDepVC = MachDepVC
-			   val discard_code = true
-			   fun stable_value_present i = false
-			   fun new_smlinfo i = ())
+    structure Compile = CompileFn (structure MachDepVC = MachDepVC
+				   fun compile_there _ = false)
 
-    structure Recomp = RecompFn (structure PS = RecompPersstate)
-    structure RT = CompileGenericFn (structure CT = Recomp)
-
-    fun recomp gp g = isSome (RT.group gp g)
+    structure BFC = BfcFn (structure MachDepVC = MachDepVC)
 
     (* instantiate Stabilize... *)
     structure Stabilize =
-	StabilizeFn (fun bn2statenv gp i = #1 (#stat (valOf (RT.bnode gp i)))
-		     val getPid = RecompPersstate.pid_fetch_sml
-		     fun warmup (i, p) = ()
-		     val recomp = recomp
-		     val transfer_state = RecompPersstate.transfer_state)
+	StabilizeFn (fun destroy_state _ i = Compile.evict i
+		     structure MachDepVC = MachDepVC
+		     fun recomp gp g = let
+			 val { store, get } = BFC.new ()
+			 val { group, ... } =
+			     Compile.newTraversal (fn _ => fn _ => (),
+						   store, g)
+		     in
+			 case group gp of
+			     NONE => NONE
+			   | SOME _ => SOME get
+		     end
+		     val getII = Compile.getII)
+
     (* ... and Parse *)
     structure Parse = ParseFn (structure Stabilize = Stabilize
-			       val pending = AutoLoad.getPending)
+			       fun pending () = SymbolMap.empty)
 
-    fun cpTextStreams (ins, outs) = let
-	val N = 4096
-	fun cp () =
-	    if TextIO.endOfStream ins then ()
-	    else (TextIO.output (outs,
-				 TextIO.inputN (ins, N));
-		  cp ())
+    (* copying an input file to an output file safely... *)
+    fun copyFile (oi, ci, oo, co, inp, outp, eof) (inf, outf) = let
+	fun workIn is = let
+	    fun workOut os = let
+		val N = 4096
+		fun loop () =
+		    if eof is then () else (outp (os, inp (is, N)); loop ())
+	    in
+		loop ()
+	    end
+	in
+	    SafeIO.perform { openIt = fn () => oo outf,
+			     closeIt = co,
+			     work = workOut,
+			     cleanup = fn () =>
+			         (F.remove outf handle _ => ()) }
+	end
     in
-	cp ()
+	SafeIO.perform { openIt = fn () => oi inf,
+			 closeIt = ci,
+			 work = workIn,
+			 cleanup = fn () => () }
     end
 
-    fun openTextStreams (inf, outf) () =
-	(TextIO.openIn inf, AutoDir.openTextOut outf)
-    fun closeTextStreams (ins, outs) =
-	(TextIO.closeIn ins; TextIO.closeOut outs)
-
-    fun copyFile (inf, outf) =
-	SafeIO.perform { openIt = openTextStreams (inf, outf),
-			 closeIt = closeTextStreams,
-			 work = cpTextStreams,
-			 cleanup = fn () =>
-			    (F.remove outf handle _ => ()) }
+    val copyTextFile =
+	copyFile (TextIO.openIn, TextIO.closeIn,
+		  AutoDir.openTextOut, TextIO.closeOut,
+		  TextIO.inputN, TextIO.output, TextIO.endOfStream)
+
+    val copyBinFile =
+	copyFile (BinIO.openIn, BinIO.closeIn,
+		  AutoDir.openBinOut, BinIO.closeOut,
+		  BinIO.inputN, BinIO.output, BinIO.endOfStream)
 
     fun compile deliver dbopt = let
 
@@ -100,7 +110,7 @@
 			    P.toString { isAbs = false, vol = "",
 					 arcs = bootdir :: arc1 :: arcn }
 		    in
-			copyFile (p, bootpath)
+			copyBinFile (p, bootpath)
 		    end
 		in
 		    if copy andalso arc0 = bindir then doCopy () else ();
@@ -111,7 +121,7 @@
 		end
 	      | _ => raise Fail "BootstrapCompile:listName: bad name"
 
-	val keep_going = EnvConfig.getSet StdConfig.keep_going NONE
+	val keep_going = #get StdConfig.keep_going ()
 
 	val ctxt = SrcPath.cwdContext ()
 
@@ -138,7 +148,7 @@
 	    { primconf = primconf,
 	      fnpolicy = fnpolicy,
 	      pcmode = pcmode,
-	      symenv = SSV.env,
+	      symval = SSV.symval,
 	      keep_going = keep_going,
 	      pervasive = pervasive,
 	      corenv = corenv,
@@ -167,12 +177,13 @@
 	    val ovldR = GenericVC.Control.overloadKW
 	    val savedOvld = !ovldR
 	    val _ = ovldR := true
+	    val sbnode = Compile.newSbnodeTraversal ()
 
 	    (* here we build a new gp -- the one that uses the freshly
 	     * brewed pervasive env, core env, and primitives *)
-	    val core = valOf (RT.sbnode ginfo_nocore core)
-	    val corenv =  CoerceEnv.es2bs (#1 (#stat core))
-	    val core_sym = #1 (#sym core)
+	    val core = valOf (sbnode ginfo_nocore core)
+	    val corenv =  CoerceEnv.es2bs (#statenv (#ii core) ())
+	    val core_sym = #symenv (#ii core) ()
 
 	    (* The following is a bit of a hack (but corenv is a hack anyway):
 	     * As soon as we have core available, we have to patch the
@@ -182,15 +193,18 @@
 	    val ginfo_justcore = { param = param_justcore, groupreg = groupreg,
 				   errcons = errcons }
 
-	    fun rt n = valOf (RT.sbnode ginfo_justcore n)
+	    fun rt n = valOf (sbnode ginfo_justcore n)
 	    val rts = rt rts
 	    val pervasive = rt pervasive
 
 	    fun sn2pspec (name, n) = let
-		val { stat = (s, sp), sym = (sy, syp), ctxt } = rt n
+		val { ii = { statenv, symenv, statpid, sympid }, ctxt } = rt n
 		val env =
-		    E.mkenv { static = s, symbolic = sy, dynamic = emptydyn }
-		val pidInfo = { statpid = sp, sympid = syp, ctxt = ctxt }
+		    E.mkenv { static = statenv (),
+			      symbolic = symenv (),
+			      dynamic = emptydyn }
+		val pidInfo =
+		    { statpid = statpid, sympid = sympid, ctxt = ctxt }
 	    in
 		{ name = name, env = env, pidInfo = pidInfo }
 	    end
@@ -199,30 +213,36 @@
 
 	    val _ = ovldR := savedOvld
 
-	    (* This is a hack but must be done for both the symbolic
+	    (* The following is a hack but must be done for both the symbolic
 	     * and later the dynamic part of the core environment:
 	     * we must include these parts in the pervasive env. *)
-	    val perv_sym = E.layerSymbolic (#1 (#sym pervasive), core_sym)
+	    val perv_sym = E.layerSymbolic (#symenv (#ii pervasive) (),
+					    core_sym)
 
 	    val param =
 		mkParam { primconf = Primitive.configuration pspecs,
-			  pervasive = E.mkenv { static = #1 (#stat pervasive),
+			  pervasive = E.mkenv { static =
+					         #statenv (#ii pervasive) (),
 					        symbolic = perv_sym,
 						dynamic = emptydyn },
 			  pervcorepids =
 			    PidSet.addList (PidSet.empty,
-					    [#2 (#stat pervasive),
-					     #2 (#sym pervasive),
-					     #2 (#stat core)]) }
+					    [#statpid (#ii pervasive),
+					     #sympid (#ii pervasive),
+					     #statpid (#ii core)]) }
 		        { corenv = corenv }
 	    val stab =
 		if deliver then SOME true else NONE
 	in
 	    case Parse.parse NONE param stab maingspec of
 		NONE => false
-	      | SOME (g, gp) =>
-		    if recomp gp g then let
-			val rtspid = PS.toHex (#2 (#stat rts))
+	      | SOME (g, gp) => let
+		    fun store _ = ()
+		    val { group = recomp, ... } =
+			Compile.newTraversal (fn _ => fn _ => (), store, g)
+		in
+		    if isSome (recomp gp) then let
+			val rtspid = PS.toHex (#statpid (#ii rts))
 			fun writeList s = let
 			    fun add ((p, flag), l) = let
 				val n = listName (p, true)
@@ -243,7 +263,6 @@
 			    app show bootstrings
 			end
 		    in
-		      Say.say ["Runtime System PID is: ", rtspid, "\n"];
 		      if deliver then
 		       (SafeIO.perform { openIt = fn () =>
 					   AutoDir.openTextOut pidfile,
@@ -260,12 +279,14 @@
 					 cleanup = fn () =>
 					   OS.FileSys.remove listfile
 					   handle _ => () };
-			copyFile (SrcPath.osstring initgspec, cmifile))
+			copyTextFile (SrcPath.osstring initgspec, cmifile);
+			Say.say ["Runtime System PID is: ", rtspid, "\n"])
 		      else ();
 		      true
 		    end
 		    else false
-	end handle Option => (RT.reset (); false)
+		end
+	end handle Option => (Compile.reset (); false)
 	    	   (* to catch valOf failures in "rt" *)
     in
 	case BuildInitDG.build ginfo_nocore initgspec of
@@ -273,12 +294,17 @@
 	  | NONE => false
     end
 
+    fun reset () =
+	(Compile.reset ();
+	 Parse.reset ())
+
     val make' = compile false
     fun make () = make' NONE
-    val deliver' = compile true
+    fun deliver' arg =
+	SafeIO.perform { openIt = fn () => (),
+			 closeIt = reset,
+			 work = fn () => compile true arg,
+			 cleanup = fn () => () }
     fun deliver () = deliver' NONE
-    fun reset () =
-	(RecompPersstate.reset ();
-	 RT.resetAll ();
-	 Recomp.reset ())
+    val symval = SSV.symval
 end

<script type="text/javascript">//<![CDATA[
		function toggle_ffErrors() {
			var errorsblock = document.getElementById("ffErrorsBlock");
			var errorsgroup = document.getElementById("ffErrors");
			if (errorsblock.style.display == "none") {
				errorsblock.style.display = "block";
				errorsgroup.style.right = "10px";
			} else {
				errorsblock.style.display = "none";
				errorsgroup.style.right = "300px";
			}
		}
//]]></script>
<div id="ffErrors">
<a href="javascript:toggle_ffErrors();">Click to toggle</a>
<div id="ffErrorsBlock">
	<div class="error">does not end with &lt;/html&gt; tag</div>
	<div class="error">does not end with &lt;/body&gt; tag</div>
	<div class="info">The output has ended thus: 	(RecompPersstate.reset ();
-	 RT.resetAll ();
-	 Recomp.reset ())
+    val symval = SSV.symval
 end</div>
</div></div>
</body></html>