;;; -*- Mode: Common-Lisp; Package: User; Base: 10.; Patch-File: T -*-

;;; Reason: Turn off more processing in LISP-REINITIALIZE during printing herald. This can cause delayed-processes to remain in STOP state until user presses keyboard.

;;;                           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, M/S 2151             
;;;   AUSTIN, TEXAS 78769                 
;;;
;;; Copyright (C) 1989 Texas Instruments Incorporated.
;;; All rights reserved.

;;; Patch file for SYSTEM version 6.36
;;; Written 06/04/90 10:33:22 by BERGER,
;;; while running on ARIES from band LODX
;;; With SYSTEM 6.35, VIRTUAL-MEMORY 6.3, EH 6.8, MAKE-SYSTEM 6.3, MICRONET 6.0, LOCAL-FILE 6.2,
;;;  BASIC-PATHNAME 6.5, NETWORK-SUPPORT-COLD 6.2, BASIC-NAMESPACE 6.8, NETWORK-NAMESPACE 6.1,
;;;  DISK-IO 6.3, DISK-LABEL 6.0, BASIC-FILE 6.13, MAC-PATHNAME 6.0, NETWORK-PATHNAME 6.2,
;;;  COMPILER 6.18, TV 6.25, DATALINK 6.0, CHAOSNET 6.8, GC 6.4, MEMORY-AUX 6.0, NVRAM 6.3,
;;;  SYSLOG 6.2, STREAMER-TAPE 6.6, UCL 6.0, INPUT-EDITOR 6.0, METER 6.2, ZWEI 6.18,
;;;  DEBUG-TOOLS 6.4, NETWORK-SUPPORT 6.1, NETWORK-SERVICE 6.3, DATALINK-DISPLAYS 6.0,
;;;  FONT-EDITOR 6.1, SERIAL 6.0, PRINTER 6.7, MAC-PRINTER-TYPES 6.2, PRINTER-TYPES 6.2,
;;;  IMAGEN 6.1, SUGGESTIONS 6.1, MAIL-DAEMON 6.6, MAIL-READER 6.8, TELNET 6.1, VT100 6.0,
;;;  NAMESPACE-EDITOR 6.5, PROFILE 6.3, VISIDOC 6.7, TI-CLOS 6.49, CLEH 6.5, IP 3.65,
;;;  Experimental CLX 6.11, CLUE 6.104, X11M 6.24, Experimental BUG 11.19,  microcode 483,
;;;  Band Name: Release 6.1-A  5-31

#!C
; From file LISP-REINITIALIZE.LISP#> KERNEL; Hotel:
#10R SYSTEM#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "SYSTEM"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* *COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: KERNEL; LISP-REINITIALIZE.#"


(DEFUN LISP-REINITIALIZE (&OPTIONAL (CALLED-BY-USER T)
			  &AUX (COLD-BOOT COLD-BOOTING))

  (SETQ INHIBIT-SCHEDULING-FLAG T)		;In case called by the user
  (SETQ ALPHABETIC-CASE-AFFECTS-STRING-COMPARISON NIL)

  ;; If these are set wrong, all sorts of things don't work.
  (SETQ LOCAL-DECLARATIONS NIL
	FILE-LOCAL-DECLARATIONS NIL
	UNDO-DECLARATIONS-FLAG NIL
	COMPILER:QC-FILE-IN-PROGRESS NIL)

  (Unless CALLED-BY-USER
    (SETQ *INTERPRETER-ENVIRONMENT* NIL
	  *INTERPRETER-FUNCTION-ENVIRONMENT* NIL
	  *INTERPRETER-MAXIMUM-ERROR-CHECKING* NIL)
    (SETQ *LISP-MODE* :common-lisp
	  *READTABLE* common-lisp-READTABLE
	  *READER-SYMBOL-SUBSTITUTIONS* *common-lisp-symbol-substitutions*
	  ZWEI:*DEFAULT-MAJOR-MODE* :common-lisp))

  ;; Initialize the NuBus slots, currently inits ENC only.  RAF 3/5/85. 
  (Unless CALLED-BY-USER (Hardware-Boot-Initializations COLD-BOOT))

  (UNCLOSUREBIND '(* ** *** + ++ +++ / // /// *VALUES*))
  (SETQ DEFAULT-CONS-AREA WORKING-STORAGE-AREA)	;Reset default areas.
  (NUMBER-GC-ON t)

  ;;Flush any closure binding forwarding pointers
  ;;left around from a closure we were in when we warm booted.
  (UNCLOSUREBIND '(PRIN1 *PRINT-BASE* *NOPOINT FDEFINE-FILE-PATHNAME INHIBIT-FDEFINE-WARNINGS
			 SELF sys:self-mapping-table SI:PRINT-READABLY *PACKAGE* *READTABLE*))

  ;;  Flush bindings of EH variables.
  (unclosurebind 'eh:(*error-message-hook* *error-depth* *errset-status* *error-handler-running*
		      *condition-handlers* *condition-default-handlers* *condition-resume-handlers*))

  ;;  EH initializations, cannot be put in an initialisation because the function
  ;;  INITIALIZATIONS has a catch-error-restart that binds one or more of them.
  (setq eh:*condition-handlers* nil
	eh:*condition-default-handlers* nil
	eh:*condition-resume-handlers* nil)

  (WHEN (VARIABLE-BOUNDP ZWEI:*LOCAL-BOUND-VARIABLES*)
    (UNCLOSUREBIND ZWEI:*LOCAL-BOUND-VARIABLES*))
  (UNCLOSUREBIND '(ZWEI:*LOCAL-VARIABLES* ZWEI:*LOCAL-BOUND-VARIABLES*))

  ;; Initialize the rubout handler.
  (SETQ	RUBOUT-HANDLER NIL TV:RUBOUT-HANDLER-INSIDE NIL)   ;We're not in it now

  ;And all kinds of randomness...
  (init-random-variables)

  (SETQ *PACKAGE* PKG-USER-PACKAGE)

  (makunbound 'lisp-crash-list)
  
  ;Reattach IO streams.  Note that *TERMINAL-IO* will be fixed later to go to a window.
  (COND ((NOT CALLED-BY-USER)
	 (UNCLOSUREBIND '(*TERMINAL-IO* *STANDARD-OUTPUT* *STANDARD-INPUT*
			  *QUERY-IO* *TRACE-OUTPUT* *ERROR-OUTPUT* *DEBUG-IO*))
	 ))

  ;; Find page partitions. Must be done before SYSTEM inits are run.
  (WHEN (NOT CALLED-BY-USER)
    (INIT-COLD-LOAD-DISK-AND-PAGING cold-boot))			;; *ab*

    ;; These are initializations that have to be done before other initializations
  (INITIALIZATIONS 'SYSTEM-INITIALIZATION-LIST T)

  ;; At this point if the window system is loaded, it is all ready to go
  ;; and the initial Lisp listener has been exposed and selected.  So do
  ;; any future typeout on it.  But if any typeout happened on the cold-load
  ;; stream, leave it there (clobbering the Lisp listener's bits).  This does not
  ;; normally happen, but just in case we do the set-cursorpos below so that
  ;; if anything strange gets typed out it won't get erased.  Note that normally
  ;; we do not do any typeout nor erasing on the cold-load-stream, to avoid bashing
  ;; the bits of whatever window was exposed before a warm boot.
  (COND (CALLED-BY-USER)
	((FBOUNDP 'TV:WINDOW-INITIALIZE)
	 (MULTIPLE-VALUE-BIND (X Y) (FUNCALL *TERMINAL-IO* :READ-CURSORPOS)
	   (FUNCALL TV:INITIAL-LISP-LISTENER :SET-CURSORPOS X Y))
	 (SETQ *TERMINAL-IO* TV:INITIAL-LISP-LISTENER)
 	 (FUNCALL *TERMINAL-IO* :SEND-IF-HANDLES :SET-PACKAGE *PACKAGE*)
	 (unless (si:cool-boot-p) (FUNCALL *TERMINAL-IO* :FRESH-LINE)))
	(T (SETQ TV:INITIAL-LISP-LISTENER NIL)	;Not created yet
	   (FUNCALL *TERMINAL-IO* :CLEAR-EOL)))

  (AND CURRENT-PROCESS
       (FUNCALL CURRENT-PROCESS :RUN-REASON 'LISP-INITIALIZE))

  ; prevent screw from things being traced during initialization
  (if (fboundp 'untrace-1) (untrace))
  (if (fboundp 'breakon) (unbreakon))

  (IF COLD-BOOTING (INITIALIZATIONS 'COLD-INITIALIZATION-LIST))

  ;;
  ;; As soon as the initial lisp listener is available, set up the
  ;; initial screen heading.
  ;; Added by Ken Bice 1/19/87
  ;;
  (UNLESS (or (EQ *terminal-io* cold-load-stream)
	      (null (send tv:*initial-screen* :exposed-p)))
    (send *terminal-io* :clear-screen)
    (Initial-Screen-Heading))

  (INITIALIZATIONS 'WARM-INITIALIZATION-LIST T)

  (SETQ COLD-BOOTING NIL)

  ;; DAB 04-20-89 This used to be the last thing done, but I don't what the message being displayed on a background window.
  (Initializations 'user-application-initialization-list T)  ;04-18-89 DAB

  ;;
  ;; The first print herald differs from the print herald only in printing
  ;; some extra information (eg, how to login, how to print complete print herald).
  ;; Added by Ken Bice 1/19/87
  ;;

  ;; DAB 06-04-90 Turn Off more processing so  delayed processes can be activated below.
  (let ((tv:more-processing-global-enable nil)) 
    (cond ((and (si:mp-system-p)
		(null (send tv:*initial-screen* :exposed-p))))
	  ((FBOUNDP 'First-PRINT-HERALD)
	   (First-PRINT-HERALD))
	(:else
	 (FUNCALL *STANDARD-OUTPUT* :CLEAR-EOL)
	 (TERPRI)
	 (PRINC "Lispm Kernel Environment")))
    )

  (AND (BOUNDP 'TIME:*LAST-TIME-UPDATE-TIME*)
       (NULL (CAR COLD-BOOT-HISTORY))
       (SETF (CAR COLD-BOOT-HISTORY) (CATCH-ERROR (LIST SI:LOCAL-HOST
							(GET-UNIVERSAL-TIME)))))

  ;; This process no longer needs to be able to run except for the usual reasons.
  ;; The delayed-restart processes may now be allowed to run
  (COND (CURRENT-PROCESS
	 (FUNCALL CURRENT-PROCESS :REVOKE-RUN-REASON 'LISP-INITIALIZE)
	 (WHEN WARM-BOOTED-PROCESS
	   (FORMAT T "Warm boot while running ~S.
Its variable bindings remain in effect;
its unwind-protects have been lost.~%" WARM-BOOTED-PROCESS)
	   (WHEN (NOT (OR (EQ (PROCESS-WARM-BOOT-ACTION WARM-BOOTED-PROCESS)
			      'PROCESS-WARM-BOOT-RESTART)
			  (EQ WARM-BOOTED-PROCESS INITIAL-PROCESS)
			  (TYPEP WARM-BOOTED-PROCESS 'SI:SIMPLE-PROCESS)))
	     (IF (YES-OR-NO-P "Do you want to Debug it?  ")
		 (PROGN 
		   (FORMAT T "~%~&The state available in the debugger is not quite the latest one.~%~%")
		   (DEBUG-WARM-BOOTED-PROCESS)
		   (format t "~2&Type (SI:RESET-WARM-BOOTED-PROCESS) to reset the process.~2%"))
		 (RESET-WARM-BOOTED-PROCESS))))
	 (LOOP FOR (P . RR) IN DELAYED-RESTART-PROCESSES
	       DO (WITHOUT-INTERRUPTS
		    (SETF (PROCESS-RUN-REASONS P) RR)
		    (PROCESS-CONSIDER-RUNNABILITY P)))
	 (SETQ DELAYED-RESTART-PROCESSES NIL)))

  ;; The global value of *TERMINAL-IO* is a stream which goes to an auto-exposing
  ;; window.  Some processes, such as Lisp listeners, rebind it to something else.
  ;; CALLED-BY-USER is T if called from inside one of those.
  (COND ((AND (NOT CALLED-BY-USER)
	      (FBOUNDP TV:DEFAULT-BACKGROUND-STREAM))
	 (SETQ *TERMINAL-IO* TV:DEFAULT-BACKGROUND-STREAM)))

  ;; Now that -all- initialization has been completed, allow network servers
  (SETQ CHAOS:CHAOS-SERVERS-ENABLED T)

  )
))