;;; -*- Mode:LISP; Package:K-KBUG; Base:10; Readtable:CL -*-
;;;
;;; WARM-FILES.LISP
;;;
;;;
;;; This file provides some user functions to boot the K processor and
;;; download system files.
;;;
;;; The function (MEGA-BOOT) builds a new cold load, writes the cold load
;;; to the K processor, and boots the K processor.  Then it downloads the
;;; files on the user#:*warm-loaded-files* list.  Next, it runs the function
;;; (LISP-INTERNALS::WARM-BOOT) on the K processor, which initializes the
;;; package system and evaluator.  Finally, it downloads the files on the
;;; *hot-loaded-files* list.
;;;
;;; When supplied with a non-NIL optional argument, MEGA-BOOT does not
;;; build a new cold load.  Instead, it reuses the last one created.
;;;
;;; Each entry of user#:*warm-loaded-files* and user#:*hot-loaded-files* is either a string
;;; (the filename) or a list of two elements, the filename and a second value.
;;; This second value controls whether or not the corresponding KENV file should
;;; be loaded.  If it is true, or the entry is just a filename, then the KENV
;;; file is loaded on the lambda at the same time the KFASL file is loaded on
;;; the K processor.  If it is NIL, then the KENV file is suppressed.
;;;
;;; Note:  When the lambda is freshly booted, it needs to know what slot the K
;;; processor is in before MEGA-BOOT can be run.  The function which does this
;;; is (LAM:K-LOCAL-SETUP <slot>), where <slot> is the slot number of the K 
;;; memory board (the one with the LED's)
;;;
;;; (James Rauen 4-Mar-88 20:25:13)


(defun warm-compile-and-load-file (file
				   &optional (compile-type :compile) (load-kenv-file t) (download t))
  (let* ((kfasl-real-pathname  (zl:probef (fs:merge-pathname-defaults file nil "KFASL" :newest)))
	 (file-needs-compiling (cold:cold-file-needs-compiling? file kfasl-real-pathname)))
    (when (or (and file-needs-compiling
		   (or (eq compile-type :compile)
		       (eq compile-type :recompile)))
	      (and (eq compile-type :recompile)
		   (not file-needs-compiling)
		   ))
      (let ((*package* (zl:pkg-find-package 'user)))
	(compiler:::nlisp:compile-file file))))
  (when download
    (kbug-fasl file))
  (when load-kenv-file
    (load-kenv-file file)))

(defun cross-compile-and-load-file (file
				    &optional (compile-type :compile)(load-fdef-file t) (download t))
  (let* ((fbin-real-pathname   (zl:probef (fs:merge-pathname-defaults file nil "FBIN" :newest)))
	 (file-needs-compiling (cold:cold-file-needs-compiling? file fbin-real-pathname)))
    (when (or (and file-needs-compiling
		   (or (eq compile-type :compile)
		       (eq compile-type :recompile)))
	      (and (not file-needs-compiling)
		   (eq compile-type :recompile)))
      (let ((*package* (zl:pkg-find-package 'user)))
	(compiler::compile-file-for-falcon file))))
  (when download
    (kbug-download-fbin file))
  (when load-fdef-file
    (load-fdef-file file)))

(defun hot-load (&optional (file-list user#:*hot-loaded-files*) (compile-type :compile) (download t))
  "Warm-boot the K and load the files in FILE-LIST"
  (wait-for-kbug-cmd-idle)
  $$$ Added messages about warm booting JIM 11/11/88
  (format t "~&Going to Warm Boot the FALCON.")
  (kbug-goto 'li:warm-boot)
  (format t "~&Finished Warm Booting the FALCON.")
  (wait-for-kbug-cmd-idle)
  (kbug-proceed)
  (do* ((flags 0 (k-mem-read (ash k2:kbug-flag-addr 2)))
	(error 0 (ldb k2:%%kbug-error-flag              flags))
	(done  0 (ldb k2:%%kbug-warm-boot-complete-flag flags)))
       ((cond ((= done  1))
	      ((= error 1) (kbug-stop) (error "The k got an error during warm-boot.")))
	(kbug-stop)))
  (warm-load file-list compile-type download)
  (wait-for-kbug-cmd-idle)
  (kbug-proceed)  ;;||| Added last three lines 9/28/88 --wkf
  (sleep .5)
  (kbug-stop)
  (kbug2))

(defvar *downloaded-files* nil "a list of warm and hot files downloaded by latest MEGA-BOOT")
(defvar *mega-boot-history* nil "a list of lists of files downloaded")

(defun mega-boot (&key fast (compile-type :compile)(load-type :load)(no-warn :just-warn) (warning-stream nil))
  (unless (or lam:*local-k-slot*
	      (not lam:*local-debugging*))
    (error "~% You did not call (lam:k-local-setup n) 
             or (k-setup) for non local debugging"))

  (push (cons cold:*cold-files-loaded* *downloaded-files*)
	*mega-boot-history*)

  ;; WARM-DOWNLOAD pushes pathnames on this list
  (setq *downloaded-files* nil)
  
  (telnet:without-more-processing *terminal-io*
    (let ((si#:inhibit-fdefine-warnings no-warn)
	  (*package* (find-package 'k-kbug)))
      (k-boot :inhibit-cold-load? fast :compile-type compile-type :load-type load-type :warning-stream warning-stream)
      (format t "~%~% Begining Hot files.")
      (hot-load user#:*hot-loaded-files* compile-type))))


;;; to see how the K side of the warm-load streams work
;;; look in these files
;;;		"jb:kbug2;streams"	    loaded both on K and lambda
;;;		"jb:kbug2;k2"			
;;;		"jb:k;warm-loader"		

(defun warm-load (&optional (file-list user#:*warm-loaded-files*) (compile-type :compile) (download t))
  (dolist (f file-list)
    (cond
      ((stringp f)
       (warm-compile-and-load-file f compile-type t download))
      ((listp f)
       (let ((filename (car f))
	     (load-kenv-file? (cadr f)))
	 (warm-compile-and-load-file filename compile-type load-kenv-file? download))))))

(defun k-boot (&key inhibit-cold-load? (compile-type :compile) (load-type :load) (warning-stream t))
  (setq *falcon-error-clobbered* nil)
  (unless inhibit-cold-load?
    (k-cold:make-cold-load :load-type load-type :compile-type compile-type :format-stream warning-stream))
  (clear-breakpoint)
  (setq *breakpoints-installed* nil)
  (download-cold-load)
  
  ;; PSEUDO-BOOT reaches into the cold-load and jumps to the address of the boot function
  ;; which is at **INITIAL-CODE-ENTRY-POINT-BV-OFFSET**
  ;; MAKE-COLD-LOAD has initialized this to BOOT:COLD-BOOT-FUNCTION
  
  (pseudo-boot)
  
  ;; this call to K-RUN fires up  BOOT:COLD-BOOT-FUNCTION,BOOT:EVENT-HORIZON, and BOOT:SYNTHESIZE-COLD-LOAD
  ;; which stops with a call to TRAP::ILLOP to say "Cold load finished!"
  ;; which is picked up by the call to WHY below.
  
  (let ((msg (kbug-run-loop-then-why)))
    (cond ((not (string-equal (cadr msg) "Cold load finished!"))
	   (global:fsignal "First phase of cold load failed to finish ~A" msg))))
  
  ;;  BOOT:SYNTHESIZE-COLD-LOAD continues with a call to 
  ;;   BOOT:WARM-START which initializes the state of all traps and calls
  ;;     K2:INIT-KBUG which resets the lambda/k communications areas and
  ;;       clears the trace-trap (single-step) flag
  ;;     LI:FLUSH-CALL-STACK 
  ;;      (never returns, which is why you see that at the bottom of your stack in KBUG2...)
  ;;      calls
  ;;       BOOT:COLD-INITIALIZE-CALL-HARDWARE
  ;;       NUBUS-STUFF:CAUSE-DEBUGGER-TRAP to pause the machine in the debugger 
  ;;       BOOT:WAIT-FOR-DEBUGGER which simply loops calling itself
  ;; comments by Peter Cerrato  4/27/88
  
  (kbug2-run-loop)
  (kbug-load-cold-info :warning-stream warning-stream)		;download linkage information for cold-load functions.
  (unless (eq inhibit-cold-load? :no-warm)
    (let* ((flags (k-mem-read (ash k2:kbug-flag-addr 2)))
	   (error (ldb k2:%%kbug-error-flag              flags)))
       (when (= error 1)
	 (kbug-stop) (error "The k got an error during cold-boot.")))
    (warm-load user#:*warm-loaded-files* compile-type))
  )

(defun kbug-run-loop ()		;run k, waiting for real processor halt
  (lam:k-run)
  (sleep 3)
  (do () ((= 1 (lam:k-read-spy-program-halt)) (k-read-spy-pc))))

(defun kbug-run-loop-then-why ()
  (let ((pc (kbug-run-loop))
	(msg nil))
    (format t "~%Falcon stopped, PC=#x~x~%" pc)
    (setq msg (why))
    (dotimes (i 5) (lam:k-step))
    (list pc msg)))

(defun kbug2-run-loop ()	;run k, wait for signal from wedge that "main program" has halted. (i.e. command done)
  (lam:k-run)
  (sleep 3)
  (wait-for-kbug-cmd-idle))

(defun wait-for-kbug-cmd-idle ()
  (do () ((kbug-stopped?))))

(defun load-kenv-files ()
  (let ((*package* (zl:pkg-find-package "USER")))
    (flet ((load-kenv (filename)
	     (load (lisp:merge-pathnames filename ".kenv#>"))))
      (dolist (f user#:*cold-files*)
	(load-kenv f))
      (dolist (f user#:*warm-loaded-files*)
	(load-kenv f)))))