;;; -*- Mode:Common-Lisp; Package:SYSTEM-INTERNALS; Base:10 -*-

;;;                           RESTRICTED RIGHTS LEGEND

;;;Use, duplication, or disclosure by the Government is subject to
;;;restrictions as set forth in subdivision (c)(1)(ii) of the Rights in
;;;Technical Data and Computer Software clause at 52.227-7013.
;;;
;;;                     TEXAS INSTRUMENTS INCORPORATED.
;;;                              P.O. BOX 2909
;;;                           AUSTIN, TEXAS 78769
;;;                                 MS 2151
;;;
;;; Copyright (C) 1985- 1989 Texas Instruments Incorporated. All rights reserved.
;;;
;;; This file contains machine shutdown routines Shutdown (meant to be
;;; called by user) and System-Shutdown (can be called by system code).
;;; They quiet the system before crashing the machine (or System-Shutdown
;;; can return with :RETURN t, so might be suitable for disk-save & friends).
;;; 

;;; Package dependencies: should be loaded into whatever package rest of NVRAM
;;; system is in.  The package for the TYPE keyword is also affected.

;;; Edit History:
;;; -------------
;;; 3/85      sdk  Original (SHUTDOWN)
;;; 5/85      ab     Minor cleanup, documentation.
;;;                  Made sure all files closed.  Fixed bug in TYPE reporting.
;;;                  Added keywords :ASK to Shutdown and :RETURN and :STREAM
;;;                to System-Shutdown.  
;;; 7/85      ab     Removed *swan-song* support.  Also now screen reverse-video's
;;;                instead of greying.
;;; 9/85      ab     Broke out NVRAM & Crash record functions into ACCESSORS file.
;;;                  Prefix external names.
;;; 11/4/85   ab     NVRAM patch 2-7.  Change default stream arg for system-shutdown
;;;                to Standard-Output.
;;; 03-15-87  ab     Wrapped Notify-All-Servers in an IGNORE-ERRORS so don't get
;;;                thrown into debugger because of chaos :LOS, etc.  Updated TV:
;;;                symbols to W: symbols where appropriate.  Deleted DEFUN for
;;;                %HALT and added MAKE-OBSOLETE for it.  The actual AUX-OP for
;;;                it is now defined in DEFOP.
;;;  8/25/87 DNG   New version created for add-in board environment.
;;;		   Send sync command to LX [fixes SPR 6437].
;;; 10/22/87 DNG   Modified to not require the LX package to exist.
;;; 11/23/87 DNG   Made more modular so that local FS and Chaos can be present independently.
;;; 01-25-88  ab   Don't do wholine stuff if ADDIN.

;;; Notes:  -- Functions should be put on a Shutdown-initialization-list.  This
;;;         will require changes to Add-Initialization.
;;;         -- Would be nice if we could wait for active servers to quit.  Maybe
;;;         a keyword?


;;clm 6/16/88 - added for the MX.
(PROCLAIM '(SPECIAL si:%MX-Who-State-String-Max))

;;; This is version meant to be called by user.

(Defun Shutdown (&Key (Type :User) (Ask T))
  "Use this function to shut down the system in an orderly fashion.  It does general
cleanup work, such as calling LOGOUT, before halting the processor.
  The ASK keyword controls whether you will be asked if you REALLY want to shut down
the system.  ASK defaults to T.  Note that the shutdown will proceed after 60 seconds
if the question is not answered.
  You can use CTL-META-Abort to break out of this function before the last status message
appears.  However, the state of the system will be unknown.  The network and file
system will probably be gone.
  The TYPE keyword controls the shutdown message that will be sent to any active servers
and written to the who-line documentation window.  The message used is picked up
from the SI:SHUTDOWN-REASON-STRING property of the symbol used as TYPE.  You may take
advantage of this feature to send your own customized message to the who line when
calling Shutdown.  The default package for the TYPE symbol is SI. "
  (Let ((Go-Ahead
	 (If Ask
	   (With-Timeout ((* #o74 #o74) T);T after 60 seconds
	      (Y-Or-N-P
	       "~&Do you really want to shut down the system?~
                                   ~%(Automatic yes after 60 seconds.)"))
	   T)))
    (When Go-Ahead
      (If (Eq Type :User);If :USER type, send generic message based on userid.
	(If (And (Boundp 'User-Id) (Stringp User-Id) (Not (String-Equal User-Id "")))
	  (System-Shutdown :Type Type :Reason-String (Format () "Shutdown by user: ~A" User-Id))
	  (System-Shutdown :Type Type :Reason-String "Shutdown by local user"))
	(System-Shutdown :Type Type))))) 



;; NVRAM patch 2-7, -ab
;; Change default stream arg to standard-output.
;;; This is the version that can be called from system functions.  

(Defun System-Shutdown (&Key (Type :System) Reason-String (Stream *Standard-Output*) (Return ()))
  "This function is meant to be called only from system-level code to shut down the system
in an orderly fashion.  It does general cleanup work, such as calling LOGOUT, before halting
the processor.  DO NOT use this function if you just want the machine to drop dead because
you have encountered an unrecoverable error.  In that case, use si:%crash instead, and be
sure to provide a crash code.
  If the keyword RETURN is non-nil, this function WILL return (that is, it will shut
down all activity but not call si%crash).  If you use this option PLEASE look at the
code to make sure it does all the quieting you want done.  Do not expect the network
or the file system to be around when the function returns.  If the RETURN keyword is NIL
\(the default) the function will end by calling si:%crash with a code of 0, indicating
a normal shutdown.
  If the optional STREAM keyword is non-nil (it defaults to *STANDARD-OUTPUT*) some status
messages will be displayed to stream STREAM as the system shuts down.
  The TYPE keyword controls the shutdown message that will be sent to any active servers
and written to the who-line documentation window.  The message used is picked up
from the SI:SHUTDOWN-REASON-STRING property of the symbol used as TYPE.  You may take
advantage of this feature to send your own customized message to the who line when
calling Shutdown.  The default package for the TYPE symbol is SI.  Optionally, you may
provide a REASON-STRING that will be used as the message text."
  (If (Null Reason-String)
    (Let ((Prop-Reason (Get Type 'Shutdown-Reason-String)))
      (Setq Reason-String
	    (If (Not (Null Prop-Reason))
	      Prop-Reason
	      (Format () "Shutdown for ~A" Type)))))
  ;; Do miscellaneous cleanup.
  (when (fboundp 'chaos:notify)
    (If Stream
	(Format Stream "~%Notifying network servers"))
    (Setq Chaos::Chaos-Servers-Enabled ())	;Allow no new servers.
    (Notify-All-Servers Reason-String);Notify any friends we have left we're going down.
    )
  (If Stream
    (Format Stream "~%Processing logout"))
  (Logout);Undo user inits and get username off screen.
  (when (fboundp 'Fs::Lmfs-Close-All-Files)
    (If Stream
	(Format Stream "~%Shutting down file system"))
    ;;Close any open streams our local file system
    ;; is serving.  Not done by file sys dismount,
    ;; but may be redundant considering what comes next.
    (Fs::Lmfs-Close-All-Files)
    )
  (Close-All-Files);Close any open file streams we've left open.
  (when (fboundp 'Chaos:Reset)
    ;; Blow off any network connections
    ;; that are left.  Stand alone after this.
    (Chaos:Reset))
  (when (and (find-package "LX")
	     (funcall (or (find-symbol "LX-ACTIVE-P" "LX")
			  #'false)))
    (If Stream
	(Format Stream "~%sync Unix file system"))
    (ignore-errors
      (with-timeout (300) ; 5 seconds
	(let ((fn (find-symbol "ISSUE-SHELL-COMMAND" "LX")))
	  (funcall fn "sync")
	  (sleep 1/3)
	  (funcall fn "sync")))))
  (when (fboundp 'Fs::Dismount-File-System)
    (Fs::Dismount-File-System);Help keep file system nice.
    )
  ;; Tell user going down now.
  (If Stream
    (Format Stream "~%Shutting down system..."))
  (Without-Interrupts;Don't allow who-line updates etc.
    (Setq tv::Who-Line-Run-State "Shutdown")
    (COND  ((AND (addin-p) (FBOUNDP 'tv:display-mac-mouse-documentation))
	    (tv:display-mac-mouse-documentation
	      t "To restart: Select Warm Boot from the Special menu. To quit: Select Quit from the File menu.")
	    (copy-array-portion tv:who-line-run-state 0 (LENGTH tv:who-line-run-state)
			   tv:mac-who-string 0 (- si:%MX-Who-State-String-Max 1)))
	   ((addin-p) nil)
	   (t  ;;Don't do any of this for addin.
	    (%Open-Mouse-Cursor);Hide the mouse
	    (when (boundp 'W::Who-Line-Documentation-Window)
	      (Catch 'W::Page-Overflow			;;Dont let documentation window overflow
		(progn					;; stop shutdown
		  ;; Make mouse doc window empty.
		  (Send W::Who-Line-Documentation-Window :Clear-Screen)
		  (Send W::Who-Line-Documentation-Window :Line-Out Reason-String)
		  ;; Display message about restarting.
		  (Send W::Who-Line-Documentation-Window :Line-Out
			"To restart:  Hold both control keys and both meta keys and press RUBOUT, M, or ABORT")))
	      (W:Who-Line-Update T)
	      ))))
  ;; If no return requested, really go down by calling %crash.
  ;; First arg of 0 is normal shutdown code; object = nil.
  ;; PAWS-UP-P is t so screen will invert.
  (If (Not Return)
      (%Crash #o0 () T)))



(DEFUN Notify-All-Servers (String)
 ;; Notifies all active servers that machine is going down.
 ;; Sends STRING to all active servers.
 (LET (hosts)
   (WHEN (AND (VARIABLE-BOUNDP W:Who-Line-File-State-Sheet)
	      (TYPEP W:Who-Line-File-State-Sheet 'tv:sheet))
	      
     (LOOP FOR server IN (SEND W:Who-Line-File-State-Sheet :Servers)	;Active servers
	   DO
	   (LET ((host (tv::server-desc-host-name server)))
	     (UNLESS (MEMBER host hosts :test #'EQ)
	       ;; Don't send more than one message
	       (PUSH host hosts))))
     (LOOP FOR shost IN hosts DO
	   (IGNORE-ERRORS (chaos:notify shost string))))
   ))