Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] View of /sml/trunk/src/system/IntSys/boot-env-fn.sml
ViewVC logotype

View of /sml/trunk/src/system/IntSys/boot-env-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log

Revision 499 - (download) (annotate)
Tue Dec 7 15:44:50 1999 UTC (21 years, 7 months ago) by monnier
File size: 2942 byte(s)
This commit was generated by cvs2svn to compensate for changes in r498,
which included commits to RCS files with non-trunk default branches.
 * Copyright 1996 by Bell Laboratories
 *  boot.sml -- bootstrap environments
 *   completely redone by M.Blume (5/1998)
 *   ... and again in the course of switching over to the new CM
 *       (M. Blume, 7/1999)
signature BOOTENV = sig
    val init: unit -> { heapfile: string, procCmdLine: (unit -> unit) option }

functor BootEnvF (datatype envrequest = AUTOLOAD | BARE
		  val architecture: string
		  val cminit : string * DynamicEnv.dynenv * envrequest ->
		               (unit -> unit) option
		  val cmbmake: string -> unit) :> BOOTENV = struct

    exception BootFailure

    structure DynE = DynamicEnv
    structure Print = GenericVC.Control.Print

    fun say s = (Print.say s; Print.flush ())
    fun die s = (say s; raise BootFailure)

    (* just run CMB.make to make a new set of binfiles... *)
    fun recompile bindir =
	(say (concat ["[building new binfiles in ", bindir, "]\n"]);
	 cmbmake bindir;
	 OS.Process.exit OS.Process.success)

	structure U = Unsafe
	fun initialize (bootdir, er) = let
	    fun mkDE (U.NILrde, de) = de
	      | mkDE (U.CONSrde (rawdynpid, obj, rest), de) = let
		    val dynpid = GenericVC.PersStamps.fromBytes rawdynpid
		    mkDE (rest, DynE.bind (dynpid, obj, de))
	    val de = mkDE (!U.pStruct, DynE.empty)
	    U.pStruct := U.NILrde;
	    cminit (bootdir, de, er)

    fun init () = let
	(* grab relevant command line arguments... *)
	fun vArg (prefix, arg) =
	    if String.isPrefix prefix arg then
		SOME (String.extract (arg, size prefix, NONE))
	    else NONE
	fun bootArgs ([], bootdir, newbindir, heapfile, er) =
	    (bootdir, newbindir, heapfile, er)
	  | bootArgs ("@SMLbare" :: rest, bootdir, newbindir, heapfile, _) =
	    bootArgs (rest, bootdir, newbindir, heapfile, BARE)
	  | bootArgs (head :: rest, bootdir, newbindir, heapfile, er) =
	    (case vArg ("@SMLboot=", head) of
		 SOME bootdir =>
		     bootArgs (rest, bootdir, newbindir, heapfile, er)
	       | NONE =>
		     (case vArg ("@SMLrebuild=", head) of
			  newbindir as SOME _ =>
			      bootArgs (rest, bootdir, newbindir, heapfile, er)
			| NONE =>
			      (case vArg ("@SMLheap=", head) of
				   SOME heapfile =>
				       bootArgs (rest, bootdir, newbindir,
						 heapfile, er)
				 | NONE =>
				       bootArgs (rest, bootdir, newbindir,
						 heapfile, er))))

	val (bootdir, newbindir, heapfile, er) =
	    bootArgs (SMLofNJ.getAllArgs (),
		      "comp.boot." ^ architecture,
		      "sml." ^ architecture,
	val bootdir = OS.Path.mkCanonical bootdir
	val newbindir = Option.map OS.Path.mkCanonical newbindir
	case newbindir of
	    NONE => let
		val procCmdLine = initialize (bootdir, er)
		{ heapfile = heapfile, procCmdLine = procCmdLine }
	  | SOME nbd =>
		if nbd = bootdir then
		    die "@SMLboot= and @SMLrebuild= name the same directory\n"
		else recompile nbd

ViewVC Help
Powered by ViewVC 1.0.0