;;; newcomp.lisp -*- Package: User -*-
(in-package :user)

#|
The code in this file can be used to bootstrap a running
compiler after making changes to the static-symbol list. This
is probably also the "correct" way of getting any compiler changes
propagated to a new production lisp.core.

You need a currently running compiler (call it L1) and 
perform a series of steps to build L2, L3 and finally L4.
The order is important. You will be given instructions
after each compiler is built to
	* rebuild the startup code
	* reload a compiler core
	* clean the target: directory
as appropriate.

Make a file "boot.lisp" in the current directory
which eg has a defparameter for the changed static-symbol list
or anything else you need in the compilation environment.

|#

;;; Some SITE-DEPENDENT variables
;;;
(defvar *L1-path* #p"/usr/src/18a/nextgen/"
  "Path to working lisp target directory.")

(defvar *tmp-dir* #p"/tmp/" "Place to hold temporary files")
;;;
;;; End SITE-DEPENDENT variables

(defvar *who-am-i* *load-truename*)
(defvar *load-stuff* nil "Controls loading in comcom.lisp")
(defvar *save-files* '("target:compiler/meta-vmdef"
		       "target:compiler/generic/new-genesis"))
(defun tmp-file-name (path)
  (merge-pathnames (make-pathname :name (pathname-name path)
				  :type (pathname-type path))
		   *tmp-dir*))

(defun check-saved-files ()
  (unless (every 'probe-file
		 (mapcar 'compile-file-pathname
			 (mapcar 'tmp-file-name *save-files*)))
    (error "Whoops, lost some critical files. Can't continue!")))

(defun resolve-features()
  "Looks for FEATURES and/or MISFEATURES in target: directory
   and returns a new feature list."
  (flet ((flist (name list)
	   (let ((path (concatenate 'string "target:" name)))
	     (when (probe-file path)
	       (with-open-file (stream path)
		 (loop for symbol = (the symbol (read stream nil nil))
		   while (not (null symbol))
		   unless (member symbol list)
		   collect symbol))))))
    (let ((new-features (flist "FEATURES" *features*))
	  (mis-features (flist "MISFEATURES" nil)))
      (format t "  New features ~a~%  Mis features ~a~%"
	      new-features mis-features)
      (append new-features 
	      (set-difference *features* mis-features)))))

(defun save-file-hack(src)
  (with-open-file (stream src :element-type '(unsigned-byte 8))
    (let ((len (file-length stream)))
      (with-open-file
	  (tmp (tmp-file-name src)
	       :element-type '(unsigned-byte 8)
	       :direction :output
	       :if-exists :new-version)
	(dotimes (i len)
	  (declare (optimize (safety 0)))
	  (let ((byte (the (unsigned-byte 8)(read-byte stream))))
	    (write-byte byte tmp)))))))

(eval-when (load eval)
  (compile 'save-file-hack))

(defmacro without-L1 (&body body)
  `(let ((orig-search-list (search-list "target:")))
     (setf (search-list "target:")
	   (remove (truename *L1-path*) (search-list "target:") :test 'equal))
     (unwind-protect
	 ,@body
       (setf (search-list "target:") orig-search-list))))
 
(defun build-l2 ()
  "Run this in the L1 compiler image to build a l2 compiler"
  (without-L1
   (let ((*features* (resolve-features)))
     (load "target:tools/setup" :if-source-newer :load-source)
     (comf "target:tools/setup" :load t)
    
     (if (probe-file "boot.lisp")
	 (load "boot")
	 (warn "No bootstrap file \"boot.lisp\"?"))
     
     (load "target:tools/worldcom")
     (load (merge-pathnames "compiler/meta-vmdef" *L1-path*))
     (let ((*load-stuff* nil))
       (load "target:tools/comcom")))
    ;; Need to save new meta-vmdef and new-genesis for next step
    (loop for thing in *save-files*
      do (save-file-hack (compile-file-pathname thing))))

  (let* ((c-header-pathname "target:lisp/internals.h")
	 (old-c-header (probe-file c-header-pathname))
	 (old-c-header-date (and old-c-header (file-write-date old-c-header))))
    (load (merge-pathnames "compiler/generic/new-genesis" *L1-path*))
    (load "target:tools/worldbuild")
    (let* ((cur-c-header (probe-file c-header-pathname))
	   (cur-c-header-date
	    (and cur-c-header (file-write-date cur-c-header)))
	   (new-header-p (not (equal cur-c-header-date old-c-header-date))))
      (when new-header-p
	(write-line "You should have to rebuild the startup files now.")
	(write-line "Check for note in genesis output.")
	(loop while (not (y-or-n-p "New startup code ready? ")))
	(load "target:tools/worldbuild")
	(write-line "Don't forget to use your new \"lisp\" in the next steps"))
      (format t "Ok, you have a new kernel.core")
      (if new-header-p
	  (write-line "and a new \"lisp\" executable.")
	  (write-line "."))))

  (write-line "Worldload up a new compiler. Rename lisp.core to  L2.core.")
  (write-line "You must also now clean your target directory of fasl files.")
  (format t "When ready, run L2 and load ~a again.~%" *who-am-i*)
  (write-line "Then (build-l3).")
  (quit)
  )

(defun build-l3 ()
  "Run this in a L2 compiler to build a L3 compiler."
  (check-saved-files)
  (without-l1
   (let ((*features* (resolve-features)))
     (load "target:tools/setup" :if-source-newer :load-source)
     (comf "target:tools/setup" :load t)
     
     (if (probe-file "boot.lisp")
	 (load "boot")
	 (warn "No bootstrap file \"boot.lisp\"?"))
     
     (load "target:tools/worldcom")
     (load (merge-pathnames "meta-vmdef" *tmp-dir*))
     (let ((*load-stuff* nil))
       (load "target:tools/comcom"))))
  (load (merge-pathnames "new-genesis" *tmp-dir*))
  (load "target:tools/worldbuild")

  (write-line "Ok, you need to worldload a new compiler .core")
  (write-line "from the new kernel.core just produced.")
  (write-line "Then rename lisp.core L3.core and clean your target directory.")
  (format t "When ready, run L3, load ~a again and (build-l4)~%" *who-am-i*)
  (write-line "L2.core is now junk.")
  (quit))

(defun build-l4 ()
  (without-l1
   (let ((*features* (resolve-features)))
     (load "target:tools/setup" :if-source-newer :load-source)
     (comf "target:tools/setup" :load t)
     (makunbound '*load-stuff*)
     (load "target:tools/worldcom")
     (load "target:tools/comcom")))
  (load "target:tools/worldbuild")
  (write-line "Ok, looks like a winner. Run worldload and you are done!")
  (write-line "L3.core is now junk.")
  (quit))

;;; End-of-File
