;;; -*- 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)


;;; changed to prevent arbitrary bashing of KFASL/KENV files by :RECOMPILE  - pfc 5/2/88
;;; copies the .LISP file to create a new version before :RECOMPILE takes place --pfc 5/3/88

(defun warm-compile-and-load-file (file &optional (compile-type :compile) (load-kenv-file t) (nc:*debug-stream* t))
  (let ((kfasl-real-pathname (zl:probef (fs:merge-pathname-defaults file nil "KFASL" :newest))))
    (when (or (and (or (eq compile-type :compile)
		      (eq compile-type :recompile))
		   (cold:cold-file-needs-compiling? file kfasl-real-pathname))
	      (and (eq compile-type :recompile)
		   (not  (cold:cold-file-needs-compiling? file kfasl-real-pathname))
		   (progn
		    (let* ((pathname (fs:merge-pathname-defaults file fs:load-pathname-defaults))
			   (oldversion (zl:send (zl:send pathname :truename) :version))
			   (newpathname (fs:merge-pathname-defaults file fs:load-pathname-defaults
								    fs:*name-specified-default-type*
								    (1+ oldversion))))
		      (fs:copy-file pathname newpathname :copy-creation-date nil :copy-author nil))
		    t)
		   ))
      (global:pkg-goto 'user)
      (compiler:::nlisp:compile-file file)
      (global:pkg-goto 'k-kbug))
    (kbug-fasl file load-kenv-file)))

(defun hot-load (&optional (file-list user#:*hot-loaded-files*) (compile-type :compile))
  "Warm-boot the K and load the files in FILE-LIST"
  (kbug-goto 'li:warm-boot)
  (sleep 0.1)
  (kbug-proceed)
;  (zl:y-or-n-p "ready to continue?")
  (sleep 20)					;This is a very dangerous point.
						;If this sleep is not long enough the K could still be running WARM-BOOT
						;when we start to download the hot files.  WARM-INTERN() looks at
						; gr:*warm-symbols* and if it is not *T* it assumes that all symbols
						;still have strings in their symbol-package slot.  This assumsion
						;fails if WARM-BOOT is interrupted in the middle of interning the warm symbols
						;into the newly created packages but before it has a chance to set
						; gr:*warm-symbols* to *t*  when it is done.
						; THIS IS VERY LOSING ...
						; I am working on a better way of handling this.
						; For now the sleep must be made long enough to always complete warm-boot.
						; PFC 7/22
						;(see WARM-LOADER and WARM-BOOT)
  (kbug-stop)
  (warm-load file-list compile-type))

(defun mega-boot (&key fast (compile-type :compile)(load-type :load)(no-warn :just-warn) (warning-stream t))
  (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"))
  (telnet:without-more-processing *terminal-io*
    (let ((si#:inhibit-fdefine-warnings no-warn))      
      (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))
  (dolist (f file-list)
    (cond
      ((stringp f)
       (warm-compile-and-load-file f compile-type))
      ((listp f)
       (let ((filename (car f))
	     (load-kenv-file? (cadr f)))
	 (warm-compile-and-load-file filename compile-type load-kenv-file?))))))

(defun k-boot (&key inhibit-cold-load? (compile-type :compile) (load-type :load) (warning-stream t))
  (global:pkg-goto 'k-kbug)
  (setq *falcon-error-clobbered* nil)
  (unless inhibit-cold-load?
    (user#:make-cold-load :load-type load-type :compile-type compile-type :format-stream warning-stream))
  (global:pkg-goto 'k-kbug)
  (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)		;download linkage information for cold-load functions.
  (unless (eq inhibit-cold-load? :no-warm)
    (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-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)
  (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)))))